VBA Code to keep source formatting with VLookup

[_MS_]

Hi!

I am using VLOOKUP to lookup value (Worksheet "Criteria") from another worksheet ("Criteria Lookup"). I would like to match the source formatting (or at least the cell color).

I have tried several codes I found in other forums, but I can't get it to work. The closest I found is the one below, but I get the #value! error. I am new to vba so I'm not sure how to replace the naming properly

Can anyone help?

Thanks in advance!!

' Put in the Worksheet of vlookup SOURCE values (in the sheet
' with the customized vlookup function)

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
'Vlookup and return value with font and interior color
Dim I As Long
Dim xKeys As Long
Dim xDicStr As String
On Error Resume Next
xKeys = UBound(xDic.Keys)
If xKeys >= 0 Then
For I = 0 To UBound(xDic.Keys)
xDicStr = xDic.Items(I)
If xDicStr <> "" Then
Worksheets("destination").Range(xDic.Keys(I)).Interior.Color = _
Worksheets("source").Range(xDic.Items(I)).Interior.Color
Worksheets("destination").Range(xDic.Keys(I)).Font.ColorIndex = _
Worksheets("source").Range(xDic.Items(I)).Font.ColorIndex
Else
Worksheets("destination").Range(xDic.Keys(I)).Interior.Color = xlNone
End If
Next
Set xDic = Nothing
End If
Application.ScreenUpdating = True
End Sub

Replace Worksheets("destination")with the sheet name that you inserted the
LookupKeepColor Function into. Replace Worksheets("source") with values you are looking up.

Replace vlookup in the sheet with the syntax like LookupKeepColor(E2,$A$1:$C$8,3)

Add Reference 'Microsoft Script Runtime' by Tools > References.

'Put in a Module
Public xDic As New Dictionary
Function LookupKeepColor(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell As Range
On Error Resume Next
Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
If xFindCell Is Nothing Then
LookupKeepColor = ""
xDic.Add Application.Caller.Address, ""
Else
LookupKeepColor = xFindCell.Offset(0, xCol - 1).Value
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol -1).Address
End If
End Function