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]

Ah good callout! I thought they were but realized there was a value out to the right! Thank you so so much!

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Walkerwood9]

You're welcome & thanks for the feedback.

Okay don't hate me...I'm back! What would the code need to be if they were different sizes? I tried implementing it into the more complex workbook that I have and I think there are more rows so it is throwing an error on the first For Loop??

 

[Fluff]

What error do you get?

 

[Walkerwood9]

Type Mismatch Error. The two sheets are rather large and there are updates every week. I originally was just using a simple data set to try and figure out how to do it but now I am running into new problems haha.

Basically there could be new rows or columns each week I get an updated sheet and I want to be able to see what changed without manually having to go through all 3,000 lines. It would be awesome to have the cells highlighted that have changed or been added.

 

[Fluff]

Type mismatch suggests that some of the cells contain a formula error such as #N/A, #VALUE, #REF etc.

 

[Walkerwood9]

Ah oh yes, There are for sure some cells with those in them. Is there a way around that?

 

[Walkerwood9]

Or is there a way to skip columns with formulas?

 

[Walkerwood9]

I took out all the columns with formulas and it still gave me that error.

 

[Fluff]

How about

Sub Walkerwood()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim r As Long, c As Long
   Dim ws As Worksheet
   
   Set ws = Sheets("pcode")
   Ary1 = ws.Range("A1").CurrentRegion.Value2
   Ary2 = Sheets("sheet1").Range("A1").CurrentRegion.Value2
   
   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, c).Interior.Color = vbRed
                     End If
                  End If
               Next c
            Else
               ws.Rows(r).Interior.Color = vbRed
            End If
         End If
      Next r
   End With
End Sub

This should ignore any cells with errors