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

 

[narendra]

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

just read this one.
Thanks for the update