Highlight Changed Cells - Too many cells (no named range)?

Question

Hello,
I implemented the Highlight Changed Cells Function as described in the How-To-Paper from Gerd Schoeffl (How To...Highlight Changed Cells in SAP BusinessObjects Analysis for Office).
In my workbook I have two tabs with different crosstabs. I noticed that the highlighting function only works for one of them and that there is a warning for the other one: "There is no named range for Crosstab1". In the coding I saw that the error message is put out by the Highlighting Changed Cells subs but I am not sure why the problem occurs (I could not find out at which point of the runtime the error occurs, even when I tried debugging it).
When I restrict the selection to less cells it works for the same crosstab. Therefore I would assume that there are simply too many cells for the function to work, is that possible? And if so, has anybody found a solution? In the crosstab there are 376 rows and 21 columns...
This is the code that contains the error message:
Sub createMapInitial(CrossTabName As String)
    Dim map As Object
    Dim cross As Range
    Dim Cell As Variant
    Set map = CreateObject("Scripting.Dictionary")
    On Error GoTo RangeNotFound
    Set cross = Range("SAP" + CrossTabName)
    Dim RowSel As Object
    Dim ColSel As Object
    Dim rowkey As Variant
    Dim colkey As Variant
    Dim keyMap As String
' delete the last selection tables
    If Not RowSel Is Nothing Then
        Set RowSel = Nothing
    End If
    If Not ColSel Is Nothing Then
        Set ColSel = Nothing
    End If
    Set RowSel = CreateObject("Scripting.Dictionary")
    Set ColSel = CreateObject("Scripting.Dictionary")
    Call FillSelTabs(CrossTabName, RowSel, ColSel)
    For Each Cell In cross
        If isDataCell(Cell) = True Then
            rowkey = RowSel.Item(Cell.row)
            colkey = ColSel.Item(Cell.column)
            keyMap = rowkey + colkey
            Call map.Add(keyMap, Cell.value)
        End If
    Next
    Call MapCollection.Add(CrossTabName, map)
    On Error GoTo 0
    Exit Sub
RangeNotFound:
    Dim text As String
    text = "There is no named range for " + CrossTabName
    Call Application.Run("SAPAddMessage", text)
    On Error GoTo 0
End Sub
Thanks, Jan

Answer 1

Hi Werner,
I disabled the OnError handling which gave me some progress:
Now when I switch on the Highlight Changes function I receive this error message:
When I click Debug it takes me to the following part of the "update MAP and compare" sub (code will be posted below):
From my understanding in this step a key is created that consists of an identifiert (the first big string) and the elements of the selection of the data source (e.g. 27 is the region, 1144 the plant number). The smallest unit in our case is the plan and we don't have the same plant number twice in our selection, therefore the key should be unique.
When I remove the plant from my selection by filtering suddenly the Highlight Changes function works again. So it seems that this plant causes the problem but I don't really understand why. Does anybod have an idea?
Here the missing code of update map and compare (same as in the How To Paper):
Public Sub updateMapAndCompare(CrossTabName As String)  ' when called the first time, the before status must be kept - and no delta is possible
    If MapCollection Is Nothing Then
        Set MapCollection = CreateObject("Scripting.Dictionary")
    End If
' do we have information about the current crosstab already?
    Dim isNewMap As Boolean
    isNewMap = Not MapCollection.exists(CrossTabName)
    If isNewMap = True Then
        Call createMapInitial(CrossTabName)
        Exit Sub
    End If
    Dim isNewDataCell As Boolean
    Dim isChangedDataCell As Boolean
    Dim keyMap As String
    Dim sel As Variant
    Dim map As Object
    Dim newMap As Object
    Set newMap = CreateObject("Scripting.Dictionary")
    Dim Cell As Variant
    Dim cross As Range
    'On Error GoTo RangeNotFound
    Set cross = Range("SAP" + CrossTabName)
' get the correct comparison table
    Set map = MapCollection.Item(CrossTabName)
    Dim RowSel As Object
    Dim ColSel As Object
    Dim rowkey As Variant
    Dim colkey As Variant
' delete the last selection tables
    If Not RowSel Is Nothing Then
        Set RowSel = Nothing
    End If
    If Not ColSel Is Nothing Then
        Set ColSel = Nothing
    End If
    Set RowSel = CreateObject("Scripting.Dictionary")
    Set ColSel = CreateObject("Scripting.Dictionary")
    Call FillSelTabs(CrossTabName, RowSel, ColSel)
    For Each Cell In cross
        If isDataCell(Cell) = True Then
        ' task1: build up new before status - as reference for next comparison
            rowkey = RowSel.Item(Cell.row)
            colkey = ColSel.Item(Cell.column)
            keyMap = rowkey + colkey
            Call newMap.Add(keyMap, Cell.value)
        ' task2: check if cell values has changed or newly occured
            isNewDataCell = Not map.exists(keyMap)
            If isNewDataCell = True Then
                'Cell.Style = C_STYLE_NEW
            Else
                isChangedDataCell = (map.Item(keyMap) <> Cell.value)
                    If isChangedDataCell = True Then Cell.Style = C_STYLE_CHANGED
                    End If
            End If
    Next
' update the MapCollection
    Set MapCollection(CrossTabName) = newMap
    'On Error GoTo 0
        Exit Sub
RangeNotFound:
    Dim text As String
    text = "There is no named range for " + CrossTabName
    Call Application.Run("SAPAddMessage", text)
    'On Error GoTo 0
End Sub