VBA to compare data in 2 sheets, issues with existing code

Hi All,

Found some code from an old post (http://www.excelforum.com/excel-prog...ml#post3701361) which compares data in sheet1 & sheet2 and highlights differences in both sheets.

Applied below code to my sample file (attached) but picked up some limitations which I was hoping someone could help me with:
- Code seems to stop comparing any further once it reaches a blank cell
- Compares dates and values relatively well but not text columns like people's names, department names, etc.
- There also seems to be some inconsistency in comparing which i can't quite figure out

Any help would be greatly appreciated.

Sub Compare()

Dim w1 As Worksheet, w2 As Worksheet
Dim A1 As Range, A2 As Range
Dim r1 As Long, r2 As Long

Set w1 = Sheets("Sheet1"): Set w2 = Sheets("Sheet2")

r1 = w1.Range("A" & Rows.Count).End(xlUp).Row
r2 = w2.Range("A" & Rows.Count).End(xlUp).Row

Sheet1:
For Each A1 In w1.Range("A2:Q" & r1)
If A1 = "" Then GoTo Sheet2
For Each A2 In w2.Range("A2:Q" & r2)
If A1 = A2 Then GoTo GetNext
Next
A1.Interior.Color = vbYellow
GetNext: Next

Sheet2:
For Each A2 In w2.Range("A2:Q" & r2)
If A2 = "" Then Exit Sub
For Each A1 In w1.Range("A2:Q" & r1)
If A1 = A2 Then GoTo GetAnother
Next
A2.Interior.Color = vbYellow
GetAnother: Next
End Sub

Try this...

Sub Compare()
    
    Dim w1 As Worksheet, w2 As Worksheet
    Dim v1 As Variant, v2 As Variant
    Dim i As Long, j As Long, k As Long
    
    Set w1 = Sheets("Sheet1"): Set w2 = Sheets("Sheet2")
    
    v1 = w1.Range("A1").CurrentRegion.Value
    v2 = w2.Range("A1").CurrentRegion.Value
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(v1, 1)
            .Item(v1(i, 1)) = i
        Next i
        
        Application.ScreenUpdating = False
        
        For i = 2 To UBound(v2, 1)
            If .Exists(v2(i, 1)) Then
                k = .Item(v2(i, 1))
                .Item(v2(i, 1)) = 0
                For j = 2 To UBound(v2, 2)
                    If v1(k, j) <> v2(i, j) Then
                        w1.Cells(k, j).Interior.Color = vbYellow
                        w2.Cells(i, j).Interior.Color = vbYellow
                    End If
                Next j
            Else
                w2.Rows(i).Resize(, UBound(v2, 2)).Interior.Color = vbYellow 'No Ref match
            End If
        Next i
        
        For Each v In .Items
            If v > 0 Then
                w1.Rows(v).Resize(, UBound(v1, 2)).Interior.Color = vbYellow 'No Ref match
            End If
        Next
        
        Application.ScreenUpdating = True
        
    End With
    
End Sub


Sub Clear()
    
    Sheets(1).Cells.Interior.ColorIndex = xlNone
    Sheets(2).Cells.Interior.ColorIndex = xlNone
    
End Sub

You're welcome.

In the VBA Editor, highlight the UBound term and press the F1 key for a description.

The Scripting.Dictionary doesn't have VBA help. It's a special array that has a very fast method to compare Records. It's used in this case to store the 1st sheet ID's (Refs) along with their row numbers (i). Then the 2nd sheet's ID's are compared to the Dictionary to find matches. Matched rows (i and k) are then compared cell by cell (j = columns).

Sub Compare_Records()
    
    ' Compares records (rows) from two worksheets based on matched record IDs
    
    ' For each macthed record pair, their cells (columns) are compared.
    ' Differentiated cells are highlightd in yellow on both sheets.
    ' It assumes the two sheets have identical data column configurations
    ' Unmatched record IDs on both sheets have their entire row highlighted.
    
    ' Adjust the worksheet references (w1 and w2)
    ' and the column number (colID) that contains the record IDs to suit.
    
    Dim w1 As Worksheet, w2 As Worksheet
    Dim v1 As Variant, v2 As Variant, v As Variant
    Dim i As Long, j As Long, k As Long, colID As Long
    
    Set w1 = Sheets("Sheet1")   'Master records sheet
    Set w2 = Sheets("Sheet2")   'Comparison records sheet
    
    v1 = w1.Range("A1").CurrentRegion.Value 'Master records data
    v2 = w2.Range("A1").CurrentRegion.Value 'Comparison records data
    
    colID = 1   'Column number that contains the record IDs to match between the two sheets; column A = 1
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        'Store the Master sheet record IDs with row numbers
        For i = 2 To UBound(v1, 1)
            .Item(v1(i, colID)) = i
        Next i
        
        Application.ScreenUpdating = False
        
        For i = 2 To UBound(v2, 1)          'Loop through Comparison sheet IDs
            If .Exists(v2(i, colID)) Then   'Find a record ID match if any
                k = .Item(v2(i, colID))     'Master sheet row number of matched ID
                .Item(v2(i, colID)) = 0     'Tag record ID as matched
                For j = LBound(v2, 2) To UBound(v2, 2)  'loop through matched record columns
                    'Highlight differentiated cells on both sheets
                    If v1(k, j) <> v2(i, j) Then
                        w1.Cells(k, j).Interior.Color = vbYellow
                        w2.Cells(i, j).Interior.Color = vbYellow
                    End If
                Next j
            Else
                'Highlight rows on Comparison sheet that had no record ID match
                w2.Rows(i).Resize(, UBound(v2, 2)).Interior.Color = vbYellow 'No ID match
            End If
        Next i
        
        'Highlight rows on Master sheet that had no record ID match
        For Each v In .Items
            If v > 0 Then
                w1.Rows(v).Resize(, UBound(v1, 2)).Interior.Color = vbYellow 'No ID match
            End If
        Next
        
        Application.ScreenUpdating = True
        
    End With
    
End Sub