0
votes

I have two sheets in an Excel Workbook, Sheet1 & Sheet2. I would like to compare these sheets with any differences between the sheets being highlighted.

I initially tried to compare the cells in sheet 1 to the cells in sheet 2 using conditional formatting. However, this does not work as new rows are added to the second sheet, so the cells no longer directly correspond with the first sheet.

I am trying to figure out how to compare, for example, a row with the name "tony" in sheet 1 to a row with the same name in sheet 2, even though the entry is in a different row/different cells in sheet 2. I would then like for any differences between the sheets to be highlighted.

1
So you have named rows or named columns or both?Karlomanio
I have named columns. One of these columns contains peoples' names and I would like, for example, to take the row that has the name as "susan" in the name column in sheet 1, and compare it to the row that has "susan" in sheet 2, even those these rows do not occupy the same cells in both sheetsGeni O
You talk about named rows on your question. It might help if you gave more context or screenshots of your data.Karlomanio
I have added links to images in the description. I would like to, for example, compare the row with Res ID 8863 in sheet 1 to the row with the same res ID in sheet 2, and highlight any differences in the rowsGeni O
The PNG images are of no use in replicating the data; data needs to be in CSV format and then we can easily import it to excel and replicate your problem. Yes, there are converters, such as newocr.com but that adds several steps to helping you.donPablo

1 Answers

0
votes

Here is a long solution. It identifies extra rows in sheet1 or in sheet2, and also highlights any cells that have different contents. Is assumes that ResID is in column C and that it is a unique identifier for each row. It sorts the two sheets by ResID to facilitate comparison.

Option Explicit

Sub do_Compare()
    ' lets assume that the columns have the same names and are in the same sequence.
    ' if not, rearrange them to make them so.

    ' some vars
    Dim f1Sheet As String, f1maxRows As Long, f1nRow As Long, f1Key As Long
    Dim f2Sheet As String, f2maxRows As Long, f2nRow As Long, f2Key As Long
    f1Sheet = "Sheet1"
    f2Sheet = "Sheet2"
    f1nRow = 2
    f2nRow = 2
    f1maxRows = Sheets(f1Sheet).Cells(Rows.Count, "A").End(xlUp).Row
    f2maxRows = Sheets(f2Sheet).Cells(Rows.Count, "A").End(xlUp).Row
    '''Cells(Rows.Count, 1).End(xlUp).Row

    ' SORT each sheet
    do_SortTheSheet f1Sheet, f1maxRows
    do_SortTheSheet f2Sheet, f2maxRows

    ' match/merge compare the keys
    Dim lowKey As Long, maxCol As Long, nCol As Long
    Sheets(f1Sheet).Select
    maxCol = Range("A1").End(xlToRight).Column
    Do While f1nRow <= f1maxRows And f2nRow <= f2maxRows
        ' get new keys
        If f1nRow <= f1maxRows Then
            f1Key = Sheets(f1Sheet).Cells(f1nRow, "C")
        Else
            f1Key = 999999999#
        End If
        If f2nRow <= f2maxRows Then
            f2Key = Sheets(f2Sheet).Cells(f2nRow, "C")
        Else
            f2Key = 999999999#
        End If

        ' find low key
        If f1Key = f2Key Then
            ' compare columns
            For nCol = 1 To maxCol
                If Sheets(f1Sheet).Cells(f1nRow, nCol) <> Sheets(f2Sheet).Cells(f2nRow, nCol) Then
                    Sheets(f1Sheet).Cells(f1nRow, nCol).Interior.ColorIndex = 22
                    Sheets(f2Sheet).Cells(f2nRow, nCol).Interior.ColorIndex = 22
                Else  ' remove any prior color
                    Sheets(f1Sheet).Cells(f1nRow, nCol).Interior.ColorIndex = 0
                    Sheets(f2Sheet).Cells(f2nRow, nCol).Interior.ColorIndex = 0
                End If
            Next nCol
            ' bump to next row
            f1nRow = f1nRow + 1
            f2nRow = f2nRow + 1
        ElseIf f1Key < f2Key Then
            ' f1 has extra row -- highlight entire row
            For nCol = 1 To maxCol
                Sheets(f1Sheet).Cells(f1nRow, nCol).Interior.ColorIndex = 22
            Next nCol
            f1nRow = f1nRow + 1
        Else ''If f1Key > f2Key Then
            ' f2 has extra row -- highlight entire row
            For nCol = 1 To maxCol
                Sheets(f2Sheet).Cells(f2nRow, nCol).Interior.ColorIndex = 22
            Next nCol
            f2nRow = f2nRow + 1
        End If

    Loop ' on the do While


End Sub

Sub do_SortTheSheet(SheetName As String, maxRows As Long)
    ' some vars and initialization
    Dim key1 As String, key2 As String, rangeAll As String, maxCol As String
    Sheets(SheetName).Select
    Cells.Select
    maxCol = Split(Columns(Range("A1").End(xlToRight).Column).Address(, False), ":")(1)

    ' (Range needs to be adjusted to fit the data) <<<<<<<<<<<<<<<
    key1 = "C2:C" & maxRows
    key2 = "B2:B" & maxRows
    rangeAll = "A1:" & maxCol & maxRows

    ' setup and do the sort
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(key1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(key2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(SheetName).Sort
        .SetRange Range(rangeAll)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub