VBA to compare rows in two different sheets, if match highlight cell

[JeremyG12]

Hello. New to this board. I found some code that compares two worksheets (sheet 2 with sheet 1) to determine if there are any differences in the rows. The code works perfect for highlighting the entire row. If there is a difference in the row on sheet 2, it is highlighted in red. Instead of highlighting the entire row, I would like to highlight the cell(s) where a change was found in each row.

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 Ws1.Range("A2", Ws1.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 Ws2.Range("A2", Ws2.Range("A" & rows.Count).End(xlUp))
Vlu = Join(Application.index(cl.Resize(, Lc).Value, 1, 0), "|")
If .exists(Vlu) = False Then cl.Resize(, Lc).Interior.color = RGB(250, 0, 0)
Next cl
End With

 

[JeremyG12]

Sorry, here's the code.

Lc = Ws2.Cells(1, Columns.Count).End(xlToLeft).Column
With CreateObject("scripting.dictionary")
    For Each cl In Ws1.Range("A2", Ws1.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 Ws2.Range("A2", Ws2.Range("A" & rows.Count).End(xlUp))
        Vlu = Join(Application.index(cl.Resize(, Lc).Value, 1, 0), "|")
        If .exists(Vlu) = False Then cl.Resize(, Lc).Interior.color = RGB(250, 0, 0)
    Next cl
End With

 

[Jamerzzzz]

I think it is as simple as changing the section

If .exists(Vlu) = False Then cl.Resize(, Lc).Interior.color = RGB(250, 0, 0)

with

If .exists(Vlu) = False Then cl.Interior.color = RGB(250, 0, 0)

this way it does not 'resize' to the entire row

 

[JeremyG12]

I think it is as simple as changing the section

If .exists(Vlu) = False Then cl.Resize(, Lc).Interior.color = RGB(250, 0, 0)

with

If .exists(Vlu) = False Then cl.Interior.color = RGB(250, 0, 0)

this way it does not 'resize' to the entire row

I had thought that similarly. It only highlights the first cell of the row where a difference is found in both sheets (VLu is a join of the first cell of a row to the last cell of the row - last column).

 

[kevin9999]

Have you considered applying CF via VBA? Please try the following on a copy of your workbook:

Option Explicit
Sub Highlight_If_Different_from_Sheet1()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")       '<-- *** Change sheet name to suit ***
    With ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, _
        ws.Cells(1, Columns.Count).End(xlToLeft).Column))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=A2<>Sheet1!A2"    '<-- *** Change sheet name to suit ***
        .FormatConditions(1).Interior.Color = vbRed
    End With
    Application.ScreenUpdating = True
End Sub

 

[JeremyG12]

Have you considered applying CF via VBA? Please try the following on a copy of your workbook:

Option Explicit
Sub Highlight_If_Different_from_Sheet1()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")       '<-- *** Change sheet name to suit ***
    With ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, _
        ws.Cells(1, Columns.Count).End(xlToLeft).Column))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=A2<>Sheet1!A2"    '<-- *** Change sheet name to suit ***
        .FormatConditions(1).Interior.Color = vbRed
    End With
    Application.ScreenUpdating = True
End Sub

I hadn't considered applying CF to solve my problem.

This code is great and does highlight cells but the rows in sheet1 and sheet2 need to be in the same order for it to work properly. The original code I posted highlighted a row that had any data in it changed (from sheet2 to sheet1) when it compared it irrespective of that row's location. If it couldn't find the row in sheet1 it would simply highlight as a "change" since it wasn't in sheet1. Hope that makes sense. Is there a way to modify your code to enable that?

Maybe using a unique identifier in the row (from sheet2) to compare with sheet1. If it's found, it compares the row for any changes and highlights cells, in sheet2, that have changed. If it's not found, it highlights the whole row, in sheet2.

Thanks for your help! I really appreciate it.

 

[kevin9999]

Is there any chance of seeing your actual data? If you can share (you can disguise any sensitive info) please post sheets 1 & 2 (only a few rows will do) using the XL2BB add in, or better still share your file via Google Drive, Dropbox or similar file sharing platform.

 

[JeremyG12]

Is there any chance of seeing your actual data? If you can share (you can disguise any sensitive info) please post sheets 1 & 2 (only a few rows will do) using the XL2BB add in, or better still share your file via Google Drive, Dropbox or similar file sharing platform.

Yes! Here's a link to the workbook (Google Drive) with a few rows of fake data.

test.xlsx

Sheet1 Name,Unique Identifier,BA,Point of Contact,Sponsor , Domains,Start Year (xxxx),End Year (xxxx),Funding ($K) Last Name,First Name,Domain 1,Domain 2,Domain 3,Domain 4,Domain 5,Domain 6,Domain 7,FY+0,FY+1,FY+2 A Test Project,ABC23716,1,Doe,John,1,n,n,n,y,n,n,n,2023,2024,180,200 Another Test ...

docs.google.com

 

[kevin9999]

Please try the following on a copy of your workbook - should accommodate rows not aligning.

Option Explicit
Sub Highlight_If_Different_from_Sheet1_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")
    With ws.Range(ws.Cells(2, 2), ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, _
        ws.Cells(1, Columns.Count).End(xlToLeft).Column))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=B2<>VLOOKUP($A2,Sheet1!$A:$R,COLUMN(),0)"
        .FormatConditions(1).Interior.Color = vbRed
    End With
    Application.ScreenUpdating = True
End Sub

 

[JeremyG12]

Please try the following on a copy of your workbook - should accommodate rows not aligning.

Option Explicit
Sub Highlight_If_Different_from_Sheet1_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")
    With ws.Range(ws.Cells(2, 2), ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, _
        ws.Cells(1, Columns.Count).End(xlToLeft).Column))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=B2<>VLOOKUP($A2,Sheet1!$A:$R,COLUMN(),0)"
        .FormatConditions(1).Interior.Color = vbRed
    End With
    Application.ScreenUpdating = True
End Sub

Kevin, this is perfect. I was able to get it to run on my data set and it highlights all the differences even in no aligning rows. I added another routine to highlight all the new rows that were not listed in sheet1 as well. Thanks for all the help! Really appreciate the assist.