Excel: How to search if spreadsheet1 value(s) exist in spreadsheet2 through VBA

Question

In spreadsheet1, column B contains values (i.e. V-9999). I'm trying to see if those values exist in spreadsheet2 column B. The issue I'm running into is that the data changes each time I update the spreadsheet and it's not always a 1:1 match between each row in column B.

For example, V-9999 may exist in cell B7 in spreadsheet1 but in spreadsheet2 V-9999 resides in cell B13. I've tried this, but I think the issue is it's trying to compare the cells for a 1:1 match, and not the actual cell value V-9999.

I'm using V-9999 as an example, but the value will change every week and can be any number between 1-100,000 pretty much, so doing a check for that whole range since inefficient instead of just checking the explicit values in spreadsheet1 and comparing to spreadsheet2.

spreadsheet1 = Current
spreadsheet2 = Previous
both spreadsheets are in the same workbook
I'm also trying to highlight the differences (spreadsheet1 will be highlighted in red for values that aren't in spreadsheet2, spreadsheet2 will be highlighted in green for values that aren't in spreadsheet1)


Sub CompareSheets()
    Dim rngCell As Range

    For Each rngCell In Worksheets("Current").Range("B2:B9999")
        If Not rngCell = Worksheets("Previous").Cells(rngCell.Column) Then _
            rngCell.Interior.Color = vbRed
        Next
        
        For Each rngCell In Worksheets("Previous").Range("B2:B9999")
            If Not rngCell = Worksheets("Current").Cells(rngCell.Column) Then _
                rngCell.Interior.Color = vbGreen
        Next
End Sub

Алексей Р Алексей Р · Accepted Answer · 2021-06-09T05:20:49

You can use Dictionary object for this:

Option Explicit

Sub CompareSheets()
    Const RNG_ADDRESS = "B2:B9999"
    ' set a reference to 'Microsoft Scripting Runtime' in Tools->References VBE menu
    Dim dict1 As New Dictionary, dict2 As New Dictionary
    Dim rngCell As Range
    
    Application.ScreenUpdating = False
    
    ' make the first dictionary
    For Each rngCell In Worksheets("Current").Range(RNG_ADDRESS)
        If Not dict1.Exists(rngCell.Text) Then dict1.Add rngCell.Text, vbNullString
    Next
    
    ' make the second dictionary
    For Each rngCell In Worksheets("Previous").Range(RNG_ADDRESS)
        If Not dict2.Exists(rngCell.Text) Then dict2.Add rngCell.Text, vbNullString
    Next
        
    ' paint cells in the Worksheets("Current") in red
    For Each rngCell In Worksheets("Current").Range(RNG_ADDRESS)
        If Not dict2.Exists(rngCell.Text) Then
            rngCell.Interior.Color = vbRed
        Else
            rngCell.Interior.ColorIndex = xlColorIndexNone
        End If
    Next
    
    ' paint cells in the Worksheets("Previous") in green
    For Each rngCell In Worksheets("Previous").Range(RNG_ADDRESS)
        If Not dict1.Exists(rngCell.Text) Then
            rngCell.Interior.Color = vbGreen
        Else
            rngCell.Interior.ColorIndex = xlColorIndexNone
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

Excel: How to search if spreadsheet1 value(s) exist in spreadsheet2 through VBA

1 Answers