CODEWITHSUNDEEP
vbaexcel
Jon
Jon

Reputation: 433

Match values in same column across two sheets and then compare entire row for differences

I have the code form another post here, but I cannot seem to get it to actually highlight individual cell differences in each row. I have a current sheet and a previous sheet; the idea is that the code should compare serial numbers in one column (the same on both worksheets) and do two things:

1) If a value appears on the Current sheet, but is not on the Previous, then the entire row on the Current sheet is highlighted Green. (This work with the current code); and 2) If a matching value is on both sheets then the rows should be compared and any value on the Current sheet that is different from the Previous is highlighted yellow. (This does not work)

The number and order of columns is always the same. The serial numbers do not change and are unique to each entry. The code that I have been looking at is:

Sub NewUpdates()

    Const ID_COL As Integer = 31 'ID is in this column
    Const NUM_COLS As Integer = 32 'how many columns are being compared?

    Dim shtNew As Excel.Worksheet, shtOld As Excel.Worksheet
    Dim rwNew As Range, rwOld As Range, f As Range
    Dim x As Integer, Id
    Dim valOld, valNew

    Set shtNew = ActiveWorkbook.Sheets("CurrentList")
    Set shtOld = ActiveWorkbook.Sheets("PreviousList")

    Set rwNew = shtNew.Rows(5) 'first entry on "current" sheet

    Do While rwNew.Cells(ID_COL).Value <> ""

        Id = rwNew.Cells(ID_COL).Value
        Set f = shtOld.UsedRange.Columns(ID_COL).Find(Id, , xlValues, xlWhole)
        If Not f Is Nothing Then
            Set rwOld = f.EntireRow

            For x = 1 To NUM_COLS
                If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
                    rwNew.Cells.Interior.Color = vbYellow
                Else
                    rwNew.Cells.Interior.ColorIndex = xlNone
                End If
            Next x

        Else
            rwNew.EntireRow.Interior.Color = vbGreen 'new entry
        End If

        Set rwNew = rwNew.Offset(1, 0) 'next row to compare

        Loop

End Sub

I did not change much of anything in the coding itself, but the original discussion that I pulled this from did not continue any further. Any ideas on updating so that I can get it highlighting the individual cells to show differences?

edit: Found the link where Tim Williams responded to a similar question and I found this code. It can be found here.

Upvotes: 0

Views: 1379

Answers (1)

assylias
assylias

Reputation: 328568

If you change the part where you change the color to yellow to this (note the additional '(x)'), it should work:

For x = 1 To NUM_COLS
    If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
        rwNew.Cells(x).Interior.Color = vbYellow
    Else
        rwNew.Cells(x).Interior.ColorIndex = xlNone
    End If
Next x

Upvotes: 2

Related Questions