Excel VBA Code to Compare Rows in Two Different Sheets and Highlight Only the Cells that are different/unique

[Walkerwood9]

I have a workbook that has two sheets in it and I want to compare these sheets (Test1 and Test 2) and highlight only the individual cells that are different/unique. The code I will provide below highlights the row if their is a match but I need the code to highlight only the cell that is NOT a match. I pulled this code from another Forum for help/reference.

Sub Test_Sheet()

Dim sheetOne As Worksheet
Dim sheetTwo As Worksheet
Dim lastRow As Long
Dim thisRow As Long
Dim lastCol As Long
Dim thisCol As Long
Dim foundRow As Range
Dim lastFoundRow As Long
Dim searchRange As Range
Dim isMatch As Boolean

' Set up the sheets
Set sheetOne = Sheets("Test1")
Set sheetTwo = Sheets("Test 2")

' Find the last row of the active sheet
lastRow = sheetOne.Cells(sheetOne.Rows.Count, "A").End(xlUp).Row

' Set the search range on the other sheet
Set searchRange = sheetTwo.Range("A1:A" & sheetTwo.Cells(sheetTwo.Rows.Count, "A").End(xlUp).Row)

' Look at all rows
For thisRow = 1 To lastRow
    ' Find the last column on this row
    lastCol = sheetOne.Cells(thisRow, sheetOne.Columns.Count).End(xlToLeft).Column
   
    ' Find the first match
    Set foundRow = searchRange.Find(sheetOne.Cells(thisRow, "A").Value, searchRange(searchRange.Count), xlValues, xlWhole)
   
    ' Must find something to continue
    Do While Not foundRow Is Nothing
        ' Remember the row we found it on
        lastFoundRow = foundRow.Row
       
        ' Check the found row has the same number of columns
        If sheetTwo.Cells(lastFoundRow, sheetTwo.Columns.Count).End(xlToLeft).Column = lastCol Then
            ' Assume it's a match
            isMatch = True
           
            ' Look at all the column values
            For thisCol = 1 To lastCol
                ' Compare the column values
                If sheetTwo.Cells(lastFoundRow, thisCol).Value <> sheetOne.Cells(thisRow, thisCol).Value Then
                    ' No match
                    isMatch = False
                    Exit For
                End If
            Next thisCol
           
            ' If it's still a match then highlight the row
            If isMatch Then sheetOne.Range(sheetOne.Cells(thisRow, "A"), sheetOne.Cells(thisRow, lastCol)).Interior.ColorIndex = 3
        End If
       
        ' Find the next match
        Set foundRow = searchRange.Find(sheetOne.Cells(thisRow, "A").Value, foundRow, xlValues, xlWhole)
       
        ' Quit out when we wrap around
        If foundRow.Row <= lastFoundRow Then Exit Do
    Loop
Next thisRow

End Sub

 

[Walkerwood9]

Hmmm I am still getting a type mismatch error with that code same line as before at the first for loop.

 

[Fluff]

Does your data start in A1 & do you have any completely blank rows or columns within the data?

 

[Walkerwood9]

It does not start in A1 and it does have both completely blank rows and columns

 

[Fluff]

In that case where does the data start & what row an column can be used to calculate the extent of the data?

 

[Walkerwood9]

Data starts at G3. Then Column G and Row 3 can be used to calculate extent of data

 

[Fluff]

Assuming that's the same for both sheets, try

Sub Walkerwood()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim r As Long, c As Long
   Dim Ws As Worksheet
   
   Set Ws = Sheets("pcode")
   r = Ws.Cells(3, Columns.Count).End(xlToLeft).Column
   Ary1 = Ws.Range("G3", Ws.Cells(Ws.Range("G" & Rows.Count).End(xlUp).Row, r)).Value2
   With Sheets("Sheet2")
      r = .Cells(3, Columns.Count).End(xlToLeft).Column
      Ary2 = .Range("G3", .Cells(.Range("G" & Rows.Count).End(xlUp).Row, r)).Value2
   End With
   With CreateObject("Scripting.dictionary")
      For r = 1 To UBound(Ary2)
         If Not IsError(Ary2(r, 1)) Then .Item(Ary2(r, 1)) = r
      Next r
      For r = 1 To UBound(Ary1)
         If Not IsError(Ary1(r, 1)) Then
            If .Exists(Ary1(r, 1)) Then
               For c = 1 To UBound(Ary1, 2)
                  If Not IsError(Ary1(r, c)) And Not IsError(Ary2(.Item(Ary1(r, 1)), c)) Then
                     If Ary1(r, c) <> Ary2(.Item(Ary1(r, 1)), c) Then
                        Ws.Cells(r + 2, c + 6).Interior.Color = vbRed
                     End If
                  End If
               Next c
            Else
               Ws.Rows(r + 2).Interior.Color = vbRed
            End If
         End If
      Next r
   End With
End Sub