Comparing two sheets and color coding rows-CodePudding

What I am trying to do is compare the rows in sheet 1 to those in sheet 2. The below images are just an example of what I am trying to do. In sheet1, the first row compared to sheet2 (columns A and C are needed to compare but not column B) is correct and the rows are blue, in the second row Column C is incorrect and shows as red which is also what I need, but the third row (column A) does not exist in sheet2 and what I need is it to either not have a color assigned to it or a different color then red if this makes sense. The code is in VBA and listed below the images.

Basically what I need is to not have row 3 colored red as column A(899) does not exist in column A in sheet2. Hopefully this clarifies this.s

Sheet1

Sheet2

Option Explicit

Sub CheckRows()
   Dim cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Vlu As String
   Dim rc As Integer
   Dim RowCount As Integer
   Dim RowCount2 As Integer
  
 
 
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("sheet2")
   RowCount = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row
   RowCount2 = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row
   With CreateObject("scripting.dictionary")
      For rc = 1 To RowCount2
         Vlu = Ws2.Range("A" & rc) & Ws2.Range("C" & rc)
         .Item(Vlu) = Empty
      Next rc
  
      For rc = 1 To RowCount
         Vlu = Ws1.Range("A" & rc) & Ws1.Range("C" & rc)
         If .exists(Vlu) Then
            Cells(rc, 1).EntireRow.Interior.color = vbGreen
            Else
            Cells(rc, 1).EntireRow.Interior.color = vbRed
         End If
      Next rc
   End With
End Sub

CodePudding user response：

Please, test the next code. It should be very fast, using arrays for and union ranges to color the interior at once, at the end:

Sub CheckRowsBis()
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim RowCount As Long, RowCount2 As Long, arr1, arr2
   Dim rngGr As Range, rngRed As Range, i As Long, j As Long
  
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Sheet2")
   RowCount = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row
   RowCount2 = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row
   Ws1.Range("A1:C" & RowCount).Interior.Color = xlNone 'clear the interior color of the whole range
   arr1 = Ws1.Range("A1:C" & RowCount).Value       'place the range in an array for faster iteration
   arr2 = Ws2.Range("A1:C" & RowCount2).Value     'place the range in an array for faster iteration
   For i = 1 To UBound(arr1)
        For j = 1 To UBound(arr2)
            If arr1(i, 1) = arr2(j, 1) Then
                If arr1(i, 3) = arr2(j, 3) Then
                    If rngGr Is Nothing Then
                       Set rngGr = Ws1.Range("A" & i & ":C" & i)
                    Else
                      Set rngGr = Union(rngGr, Ws1.Range("A" & i & ":C" & i))
                    End If
                 Else
                    If rngRed Is Nothing Then
                       Set rngRed = Ws1.Range("A" & i & ":C" & i)
                    Else
                      Set rngRed = Union(rngRed, Ws1.Range("A" & i & ":C" & i))
                    End If
                End If
            End If
        Next j
   Next
   If Not rngGr Is Nothing Then rngGr.Interior.Color = vbGreen
   If Not rngRed Is Nothing Then rngRed.Interior.Color = vbRed
End Sub

'Coloring each three cells range takes time...