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

 

[braindiesel]

Does the entire row need to match or just a targeted cell...
This is just the targeted cell using conditional formatting... no code required
Replace my named ranges with the ranges on the opposite sheets

Book1
	A	B	C
1
2	Apples		Apples
3	Bananas		Bananas
4	Cherries		Dates
5	Dates		Eggplant
6	Eggplant		Grapes
7	Figs		Honeydew
8	Grapes
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C2:C7	Expression	=COUNTIF(Test1,C2)=0	text	NO
A2:A8	Expression	=COUNTIF(Test2,A2)=0	text	NO

 

[Walkerwood9]

Does the entire row need to match or just a targeted cell...
This is just the targeted cell using conditional formatting... no code required
Replace my named ranges with the ranges on the opposite sheets

Book1
	A	B	C
1
2	Apples		Apples
3	Bananas		Bananas
4	Cherries		Dates
5	Dates		Eggplant
6	Eggplant		Grapes
7	Figs		Honeydew
8	Grapes
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C2:C7	Expression	=COUNTIF(Test1,C2)=0	text	NO
A2:A8	Expression	=COUNTIF(Test2,A2)=0	text	NO

Just a targeted cell, and I have to put this in a macro.

 

[braindiesel]

OK, so did I solve it without a macro for you?

 

[Walkerwood9]

OK, so did I solve it without a macro for you?

I appreciate the response, but unfortunately not. It needs to be VBA code I can put in a macro and run on the entire sheet (38 columns)

 

[Fluff]

Are the values in Col A unique, or can they occur multiple times?

 

[Walkerwood9]

The Values in column A are unique yes. They cannot occur multiple times only once

 

[Fluff]

Ok, 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("Test1")
   Ary1 = Ws.Range("A1").CurrentRegion.Value2
   Ary2 = Sheets("Test2").Range("A1").CurrentRegion.Value2
   
   With CreateObject("Scripting.dictionary")
      For r = 1 To UBound(Ary2)
         .Item(Ary2(r, 1)) = r
      Next r
      For r = 1 To UBound(Ary1)
         If .Exists(Ary1(r, 1)) Then
            For c = 1 To UBound(Ary1, 2)
               If Ary1(r, c) <> Ary2(.Item(Ary1(r, 1)), c) Then
                  Ws.Cells(r, c).Interior.Color = vbRed
               End If
            Next c
         Else
            Ws.Rows(r).Interior.Color = vbRed
         End If
      Next r
   End With
End Sub

 

[Walkerwood9]

Getting a subscript out of range error on this line:
If Ary1(r, c) <> Ary2(.Item(Ary1(r, 1)), c) Then

 

[Fluff]

Are both sets of data the same size?