VBA to compare rows in two different sheets and if they match highlight in red

[DMO123]

Hi, i am new to this board. i have been searching online and cannot seem to find much help around what i am trying to do.

i am looking to compare two sheets in one workbook. for example, if sheet 1 row 1 matches a row in sheet 2 then highlight it red if not leave blank. i tried:

Sub Test_Sheet()
Dim r As Range
Dim s As Range


Set s = Sheets("Already Billed").Columns(1)


For Each r In ActiveSheet.UsedRange.Rows
If Not (s.Find(r.Cells(1, 1).Value) Is Nothing) Then
r.Interior.ColorIndex = 3
End If
Next r
End Sub

but if i change the data in column 3 it does not register as the above is only looking in column 1 but i need the whole row to be check.

can someone help

thanks

 

[wideboydixon]

Comparing an entire row is quite complex. It would be better if you had a unique value to test against. However, in order to check the whole row you could try something like this:

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 = ActiveSheet
Set sheetTwo = Sheets("Already Billed")

' 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

WBD

 

[nikio8]

Chane column(1) to column(3)

 

[Fluff]

How about

Sub CheckRows()
   Dim cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Vlu As String
   Dim Lc As Long
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("sheet2")
   Lc = Ws2.Cells(1, Columns.Count).End(xlToLeft).Column
   With CreateObject("scripting.dictionary")
      For Each cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         Vlu = Join(Application.Index(cl.Resize(, Lc).Value, 1, 0), "|")
         .Item(Vlu) = Empty
      Next cl
      For Each cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         Vlu = Join(Application.Index(cl.Resize(, Lc).Value, 1, 0), "|")
         If .exists(Vlu) Then cl.Resize(, Lc).Interior.Color = vbRed
      Next cl
   End With
End Sub

 

[DMO123]

Thanks - this works perfectly!

 

[DMO123]

Sorry ignore the 2 reply's above. thanks to WBD this code worked perfectly.

 

[wideboydixon]

You're welcome. Fluff's code (once you adapt it) is probably faster and is a little more concise. If you run into performance issues, take a look at that.

WBD

 

[DMO123]

@wideboydixon and @Fluff if i wanted to only compare certain columns such as A - F how would i amend the above code(s)? as i know currently they are looking at the full row. as you mentioned about it is complex and i ran into problems

thanks!

 

[wideboydixon]

Based on Fluff's code:

Sub CheckRows()
   Dim cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Vlu As String
   Dim Lc As Long
   
   Set Ws1 = ActiveSheet
   Set Ws2 = Sheets("Already Billed")
   Lc = 6
   With CreateObject("scripting.dictionary")
      For Each cl In Ws2.Range("A2", Ws2.Range("A" & Ws2.Rows.Count).End(xlUp))
         Vlu = Join(Application.Index(cl.Resize(, Lc).Value, 1, 0), "|")
         .Item(Vlu) = Empty
      Next cl
      For Each cl In Ws1.Range("A2", Ws1.Range("A" & Ws1.Rows.Count).End(xlUp))
         Vlu = Join(Application.Index(cl.Resize(, Lc).Value, 1, 0), "|")
         If .exists(Vlu) Then cl.Resize(, Lc).Interior.Color = vbRed
      Next cl
   End With
End Sub

The line in red indicates the number of columns to compare and highlight.

WBD

 

[DMO123]

Thank this works perfectly!!