Vlookup and highlight rows

[cytochrome]

Hi there,
Could really use some help creating a macro.
I have 2 sheets, Sheet1 and Sheet2.
Sheet1 had data that trying to find (in column A). If found in Sheet2 (also in column A) then highlight that row. Do that until a blank row.
So for example Sheet1 looked like this:

PSS1234

PSS56789

Sheet2 looked like this:

Reference Number	Account
PSS2302131179587	1234
PSS1234	111
PSS2301271108512	111
PSS5678	21
PSS2301271108527	211

So after the macro ran, only row 2 and 4 of Sheet2 will get highlighted.

 

[mumps]

Assuming your data starts in row 2 of each sheet, try this macro. If necessary, change the ranges (in red) to suit your needs.

Sub ColorRows()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), Nothing
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Range("A" & i + 1).Resize(, 2).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[cytochrome]

Thank you so so much!!!. This works great.
One more enhancement if possible?
As part of the same macro, if there is a row in Sheet1 that isn't on Sheet2, can that row be highlighted as well?

 

[mumps]

Try:

Sub ColorRows()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), Nothing
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Range("A" & i + 1).Resize(, 2).Interior.ColorIndex = 6
        End If
    Next i
    dic.RemoveAll
    For i = LBound(v2) To UBound(v2)
        If Not dic.exists(v2(i, 1)) Then
            dic.Add v2(i, 1), Nothing
        End If
    Next i
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            srcWS.Range("A" & i + 1).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[cytochrome]

Thank you thank you. This works amazing. Thank you so much for you help.

 

[mumps]

You are very welcome.

 

[cytochrome]

Hi mumps,
Need help expanding this a little bit. Is it possible to vba the following?
If I now have 3 columns in sheet1, and I wanna run each row of Sheet 1 to find matching info row anywhere on sheet2. If found then highlight both rows in sheet1 and 2.
If the row is in sheet1 and not in sheet2 and vice versa then don't highlight anything.
Thanks ahead for your help.

 

[mumps]

Assuming your data is in columns A, B and C, try:

Sub ColorRows()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, val As String
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        val = v1(i, 1) & "|" & v1(i, 2) & "|" & v1(i, 3)
        If Not dic.exists(val) Then
            dic.Add val, i + 1
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        val = v2(i, 1) & "|" & v2(i, 2) & "|" & v2(i, 3)
        If dic.exists(val) Then
            desWS.Range("A" & i + 1).Resize(, 3).Interior.ColorIndex = 6
            srcWS.Range("A" & dic(val)).Resize(, 3).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[cytochrome]

Omg it works!
I cannot thank you enough.
I'm guessing if I need to expand the condition to 4 columns then I will need to change the resize(.3) to resize(.4)? And add a v1.(i. 4) and v2.(i. 4)?

 

[mumps]

You are very welcome.

I'm guessing if I need to expand the condition to 4 columns then I will need to change the resize(.3) to resize(.4)? And add a v1.(i. 4) and v2.(i. 4)?

Yes, you are correct.