Late Binding a Public Dictionary object does NOT work

[narendra]

I found below code to VLookup with cell format, it works only when you add "Microsoft Scripting Runtime" library to the workbook's VBA Project (via. Tools > Add > References)


However, to remove the need to add above library, I modified a part of the first code as below, but It Does Not Work. What am I missing here?

Public xDic As Object    'Old Statement was: Public xDic As New Dictionary
.
.
On Error Resume Next
Set xDic = CreateObject("Scripting.Dictionary")    'New Line inserted to Set Dictionary type

Note:
Tapping the Dictionary object shows that it is preserved when the code jumps from 1st code (a function) to the next (a worksheet event).


The reference data is stored in a sheet named "Master". I added a new sheet to check the VLookup
The original working code is as below.


This goes in Standard Code Module:

Public xDic As New Dictionary
Function LookupKeepFormat(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
    Dim xFindCell As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
    If xFindCell Is Nothing Then
        LookupKeepFormat = CVErr(xlErrNA)
        xDic.Add Application.Caller.Address, " "
    Else
        LookupKeepFormat = xFindCell.Offset(0, xCol - 1).Value
        xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address
    End If
    Application.ScreenUpdating = True
End Function

This goes in Worksheet module of the Sheet in which VLookup is used:

Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xKeys As Long, xDicStr As String
    Dim SrcCell As Range, DestCell As Range
    Dim MasterSh As Worksheet, MasterShName As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    MasterShName = "Master"             '<---- Change sheet name here to refer to correct data for VLookup
    Set MasterSh = Sheets(MasterShName)
    xKeys = UBound(xDic.Keys)
    If xKeys >= 0 Then
        For I = 0 To UBound(xDic.Keys)
            xDicStr = xDic.Items(I)
            Set SrcCell = MasterSh.Range(xDic.Items(I))
            Set DestCell = Range(xDic.Keys(I))
            If xDicStr <> "" Then
            If WorksheetFunction.IsNA(DestCell.Value2) Then
                Application.EnableEvents = False
                DestCell.ClearFormats
                Application.EnableEvents = True
            Else
'                Uncomment below 3 lines to include Number Formats and Conditional Formats
'                MasterSh.Range(xDic.Items(I)).Copy
'                Range(xDic.Keys(I)).PasteSpecial xlPasteFormats
'                Goto SkipPreserve
                'if above is Not executed then copy only cell format (ignore Number Formats and Conditional Formats)
                With DestCell
                  .Font.FontStyle = SrcCell.DisplayFormat.Font.FontStyle
                  .Font.Color = SrcCell.DisplayFormat.Font.Color
                  .Font.Strikethrough = SrcCell.DisplayFormat.Font.Strikethrough
                  .Interior.Color = SrcCell.DisplayFormat.Interior.Color
                  .Interior.Pattern = SrcCell.DisplayFormat.Interior.Pattern
                End With
SkipPreserve:
            End If
            Else
                DestCell.Interior.Color = xlNone
            End If
        Next
        Set xDic = Nothing
    End If
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
End Sub

 

[shg]

I'm confused by your code. Have you declared xDic twice? Is the code that initializes it in a procedure? What doesn't work?

 

[narendra]

I'm confused by your code. Have you declared xDic twice?

Hi,
xDic is only declared once in Standard code Module as:

Public xDic As Object

Is the code that initializes it in a procedure? What doesn't work?

Yes, the code is in the Worksheet_Change event procedure near to the end of the code ...

Set xDic = Nothing

Basically, the Function LookupKeepFormat returns the value from the source data and add the source data's cell reference and the formula cell reference to the dictionary. The 2nd routine then refers to that dictionary and copies cell format from source-data cell to the formula(lookup)-cell.

The problem i am facing is that the formula gets the value correctly but the procedure does NOT copy the cell format.
If you run the original code (with early binding) on a dummy data after adding "Microsoft Scripting Runtime" to the VBA project, you can set appropriate breakpoints and see that the cell address are correctly assigned to the SrcCell and DestCell variables in the procedure.

But, if i go with late-binding by modifying(declaring) the Public Variable xDic "As Object" and Set the Dictionary type in the Function code (using createobject), then both SrcCell and DestCell show value as Nothing in debug.

Hope I clarified the case.

Thanks.

 

[shg]

Yes, the code is in the Worksheet_Change event procedure near to the end of the code ...

Set xDic = Nothing

That's not the code that initializes it, this is:

On Error Resume Next
Set xDic = CreateObject("Scripting.Dictionary")

When does that run?

Also, why is On Error Resume Next there?

 

[shg]

The first step is to take out all of the On Error statements.

When you do this,

Public xDic         As New Dictionary

There is no need to initialize it, because it auto-instances when referenced. When defined as an Object, it needs to be reinitialized after you set it to nothing.

Rather than do that, you could initialize it in LookupKeepFormat ...

  If xDic Is Nothing Then Set xDic = CreateObject("Scripting.Dictionary")

... and then do RemoveAll after you've done the formatting thing in the Event code.

 

[shg]

Here's an alternative.

In a standard code module:

Public col          As Collection

Function LookupKeepFormat(ByRef vWhat As Variant, ByRef r As Range, ByRef iCol As Long)
  Dim rFind         As Range

  If col Is Nothing Then Set col = New Collection

  Set rFind = r.Columns(1).Find(What:=vWhat, _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                MatchCase:=False)

  If rFind Is Nothing Then
    col.Add Item:=Array(Application.Caller.Address(External:=True), _
                        CVErr(xlErrNA))
    LookupKeepFormat = CVErr(xlErrNA)
  Else
    col.Add Item:=Array(Application.Caller.Address(External:=True), _
                        rFind(1, iCol).Address(External:=True))
    LookupKeepFormat = rFind(1, iCol).Value2
  End If
End Function

In the Sheet module:

Sub Worksheet_Change(ByVal Target As Range)
  Dim vItem         As Variant
  Dim rForm         As Range    ' formula cell
  Dim rFind         As Range    ' found lookup cell

  If col Is Nothing Then Exit Sub

  Application.EnableEvents = False

  Do While col.Count
    vItem = col.Item(1)
    Set rForm = Application.Range(vItem(0))

    If IsError(vItem(1)) Then
      rForm.ClearFormats
    
    Else
      Set rFind = Application.Range(vItem(1))
      With rForm
        .Font.FontStyle = rFind.DisplayFormat.Font.FontStyle
        .Font.Color = rFind.DisplayFormat.Font.Color
        .Font.Strikethrough = rFind.DisplayFormat.Font.Strikethrough
        .Interior.Color = rFind.DisplayFormat.Interior.Color
        .Interior.Pattern = rFind.DisplayFormat.Interior.Pattern
      End With
    End If
    col.Remove 1
  Loop

  Application.EnableEvents = True
End Sub

 

[narendra]

I see. Thank you for the suggestion.
Will try this on Monday when I am back to work.

I am new to dictionaries so I did not know that. This code was in a file shared by someone with my co- worker.

Also, as you suggested, can I declare the public variable As "New Dictionary" without adding runtime reference to the VBA project?
That way I can keep the code portable, requiring simple copy paste to vba modules.

And sorry if this sounds dumb, but when you mentioned RemoveAll, what exactly I should be doing here?

Once again thank you for the response.

 

[shg]

I suggest you use a collection instead of a dictionary, as shown in post 6 -- no reference required.

 

[narendra]

I believe dictionary is native to VBA and so it might execute faster than vollection. If both work fine, then I will check processing speed as this will be used on fairly large data sets.

 

[narendra]

I believe dictionary is native to VBA and so it might execute faster than vollection. If both work fine, then I will check processing speed as this will be used on fairly large data sets.
Thanks.