VLookup in Excel vba not working - vba

Question

Excel File Format
I have master data table with attribute ID which is unique and unit.
I have another table where I add the product values associated with the attributes.
If the units match based on the attribute ID, then the cells are highlighted in green else red.
To achieve the above, I have written some basic code, but it doesn't seem to work. The vlookup works normally but using vba it just exits. Please see image for example and code below. Column a and b contains attribute master data and column d to g contain product attribute values.
Eg. For product p1, value 'IN' is valid for attribute 'A1' but 'm' is not valid.
Also, there can be multiple units separated by comma for each attribute. Need help to solve issue.
Code:
Sub UnitCheck()
Dim AttrIDrange As range, AttrIDcell As range
Dim attrID
Dim Lookup_Range As range
Dim I, J As Variant
Dim UNIT As Variant
Set Lookup_Range = range("A2:B4")
Set AttrIDrange = range("E1:G1")
For Each AttrIDcell In AttrIDrange
attrID = AttrIDcell.Value
For I = 2 To 3
For J = 5 To 7
If Application.WorksheetFunction.VLookup(attrID, Lookup_Range, 2, False) = UNIT Then
Worksheets("Sheet4").Cells(I, J).Font.Color = vbGreen
Else
Worksheets("Sheet4").Cells(I, J).Font.Color = vbRed
End If
Next
Next
Next
End Sub
New Scenario:
If there are multiple units defined for any attribute, then even if only 1 of the unit is present in the product value, it should be highlighed in green. If 1 is correct and rest are incorrect then since it is partially correct, it should be highlighted in red or even yellow. Please see image. Need help for this scenario.
Scenario 2 Image

Answer 1

When cycling through the I and J loops, you need to set UNIT to something before you can compare it to the results passed back from the worksheet VLOOKUP function.
Sub UnitCheck()
Dim AttrIDrange As Range, AttrIDcell As Range
Dim attrID
Dim Lookup_Range As Range
Dim I As Long, J As Long
Dim UNIT As Variant
Dim bCHECK_P1
With Worksheets("Sheet4")
bCHECK_P1 = False
Set Lookup_Range = .Range("A2:B4")
Set AttrIDrange = .Range("E1:G1")
For Each AttrIDcell In AttrIDrange '.Range("E1:G1")
attrID = AttrIDcell.Value
For I = 2 To 3
UNIT = AttrIDcell.Offset(I - 1, 0).Value '<~~ set UNIT here!
For J = 5 To 7
.Cells(I, J).Font.Color = xlAutomatic
If Application.WorksheetFunction.VLookup(attrID, Lookup_Range, 2, False) = UNIT Then
.Cells(I, J).Font.Color = vbGreen
Else
.Cells(I, J).Font.Color = vbRed
End If
Next
Next
Next
End With
End Sub

Answer 2

Here's something that I think does what the OP is asking. Also, this replaces the triple For/next and VLookUp with a dictionary which is hopefully more amenable.
In regard to the OP, I see two fundamental problems, UNIT is never assigned, but also, it sounds like the = operator isn't correct... instead, it sounds like a lookup value must be confirmed present in a comma separated string. The code below uses InStr to check if the lookup value is present.
Sub UnitCheck()
Application.ScreenUpdating = False
Dim UNIT As String
Dim R, c, AttrID As Integer
Dim ProdRange, ProdCell As Range
Set ProdRange = Range("E2:G4")
'Assign LookUp values to array
Dim LookUpArray(), ProdAttrIDArray() As Variant
LookUpArray = Range("A2:B4").Value2
'Create dictionary from Lookup values
Set D = CreateObject("Scripting.Dictionary")
For R = 1 To UBound(LookUpArray)
D.Add LookUpArray(R, 1), LookUpArray(R, 2)
Next
'Loop through product table
For Each ProdCell In ProdRange
'Get attribute ID from row 1 of corresponding column
AttrID = Cells(1, ProdCell.Column).Value2
If D(AttrID) <> Empty Then
'If AttrID found in LookUp Dictionary then get UNIT from it
UNIT = D(AttrID)
'If UNIT found in product cell then color cell green, else red
If (InStr(1, ProdCell.Value2, UNIT) > 0) Then
ProdCell.Interior.Color = vbGreen
Else
ProdCell.Interior.Color = vbRed
End If
End If
Next
End Sub
The result is this
New Scenario
Ok, I think this will cover your new scenario. Notice that I also added Trim() and VBTextCompare so that spaces are ignored and the comparison is case-insensitive. I'm not sure if you want that behavior or not. Also, notice that the order of units does not matter. For example, "IN, km" matches "KM, IN" because the spaces are ignored, capitalization is ignored, and the order is ignored.
Sub UnitCheck()
Application.ScreenUpdating = False
Dim UNIT, PUnits() As String
Dim r, c, AttrID, i, n As Integer
Dim ProdRange, ProdCell As Range
Set ProdRange = Range("E2:G3")
'Assign LookUp values to array
Dim LookUpArray(), ProdAttrIDArray() As Variant
LookUpArray = Range("A2:B4").Value2
'Create dictionary from Lookup values
Set D = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(LookUpArray)
D.Add LookUpArray(r, 1), LookUpArray(r, 2)
Next
'Loop through product table
For Each ProdCell In ProdRange
'Get attribute ID from row 1 of correspdniong column
AttrID = Cells(1, ProdCell.Column).Value2
If D(AttrID) <> Empty Then
'If AttrID found in LoopUp Dictionary then get UNIT from it
UNIT = D(AttrID)
PUnits = Split(ProdCell.Value2, ",")
'reset counter
n = 0
'Count the number of product units found in the lookup value
For i = 0 To UBound(PUnits)
If InStr(1, Trim(UNIT), Trim(PUnits(i)), vbTextCompare) > 0 Then
n = n + 1
End If
Next
'prevent division by zero
If i = 0 Then i = 1
'select action based on percent matched
Select Case n / i
Case Is >= 1
ProdCell.Interior.Color = vbGreen
Case Is > 0
ProdCell.Interior.Color = vbYellow
Case Else
ProdCell.Interior.Color = vbRed
End Select
End If
Next
End Sub