VBA compare values on different sheets.

[Tocix]

Please help fix VBA codes below. When I ran the code it color the whole column instead of mismatch values. I'm trying to compare sheet1 column D and sheet2 column C. if column C values does not exist on sheet1 column D, color the cell pink.

Sub CompareAndColor()

Dim ws1 As Worksheet

Dim ws2 As Worksheet

Dim rng1 As Range

Dim rng2 As Range

Dim cell1 As Range

Dim cell2 As Range


' Set references to the worksheets

Set ws1 = ThisWorkbook.Sheets("Sheet1")

Set ws2 = ThisWorkbook.Sheets("Sheet2")


' Set the range to compare in Sheet1 (excluding header)

Set rng1 = ws1.Range("D2:D" & ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row)



' Set the range to compare in Sheet2 (excluding header)

Set rng2 = ws2.Range("C2:C" & ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)


' Loop through each cell in rng2 and compare with rng1

For Each cell2 In rng2

For Each cell1 In rng1

If cell1.Value <> cell2.Value Then

cell2.Interior.Color = RGB(255, 192, 203) ' Pink color

Exit For ' Exit the loop once a mismatch is found

End If

Next cell1

Next cell2

End Sub

 

[rlv01]

Perhaps something like this.

Sub CompareAndColor()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim I As Long
    
    ' Set references to the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' Set the range to compare in Sheet1 (excluding header)
    Set rng1 = ws1.Range("D2:D" & ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row)
    
    ' Set the range to compare in Sheet2 (excluding header)
    Set rng2 = ws2.Range("C2:C" & ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)
    
    rng2.Interior.Color = xlNone 'reset interior color
    
    ' Loop through each cell in rng2 and compare with rng1
    For I = 1 To rng2.Rows.Count
        Set cell1 = rng1.Cells(I, 1)
        Set cell2 = rng2.Cells(I, 1)
        If cell1.Value <> cell2.Value Then
            cell2.Interior.Color = RGB(255, 192, 203) ' Pink color
            Exit For ' Exit the loop once a mismatch is found
        End If
    Next I
End Sub

 

[Tocix]

Perhaps something like this.

Sub CompareAndColor()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim I As Long
  
    ' Set references to the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
  
    ' Set the range to compare in Sheet1 (excluding header)
    Set rng1 = ws1.Range("D2:D" & ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row)
  
    ' Set the range to compare in Sheet2 (excluding header)
    Set rng2 = ws2.Range("C2:C" & ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)
  
    rng2.Interior.Color = xlNone 'reset interior color
  
    ' Loop through each cell in rng2 and compare with rng1
    For I = 1 To rng2.Rows.Count
        Set cell1 = rng1.Cells(I, 1)
        Set cell2 = rng2.Cells(I, 1)
        If cell1.Value <> cell2.Value Then
            cell2.Interior.Color = RGB(255, 192, 203) ' Pink color
            Exit For ' Exit the loop once a mismatch is found
        End If
    Next I
End Sub

 

[Tocix]

Sad to say it's not working. would it be possible to rewrite the code from scratch?

Both sheets have headers. The code will fill in cell pink if Sheet2 column C does not match sheet1 on column D. Maybe conditional formatting?

 

[mumps]

Try:

Sub CompareData()
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet, sh2 As Worksheet, v1 As Variant, v2 As Variant, dic As Object
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    v1 = sh1.Range("D2", sh1.Range("D" & Rows.Count).End(xlUp)).Value
    v2 = sh2.Range("C2", sh2.Range("C" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), Nothing
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If Not dic.exists(v2(i, 1)) Then
            sh2.Range("C" & i + 1).Interior.ColorIndex = 3
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[rlv01]

Sad to say it's not working. would it be possible to rewrite the code from scratch?

Both sheets have headers. The code will fill in cell pink if Sheet2 column C does not match sheet1 on column D. Maybe conditional formatting?

Interesting. Why do you think it is not working for you? I tested the code before I posted it, using the ranges and sheet names you specified and it works for me, changing the color of the first different cell in Sheet2 , column C to pink.