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

Walkerwood9

New Member
Joined
Jun 23, 2020
Messages
15
Office Version
365, 2016
Platform
Windows
Hmmm I am still getting a type mismatch error with that code same line as before at the first for loop.
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
41,201
Office Version
365
Platform
Windows
Does your data start in A1 & do you have any completely blank rows or columns within the data?
 

Walkerwood9

New Member
Joined
Jun 23, 2020
Messages
15
Office Version
365, 2016
Platform
Windows
It does not start in A1 and it does have both completely blank rows and columns
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
41,201
Office Version
365
Platform
Windows
In that case where does the data start & what row an column can be used to calculate the extent of the data?
 

Walkerwood9

New Member
Joined
Jun 23, 2020
Messages
15
Office Version
365, 2016
Platform
Windows
Data starts at G3. Then Column G and Row 3 can be used to calculate extent of data :)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
41,201
Office Version
365
Platform
Windows
Assuming that's the same for both sheets, try
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,100,042
Messages
5,472,142
Members
406,806
Latest member
babarfirasat

This Week's Hot Topics

Top