Comparing two worksheets with different column order

1
votes

I'm trying to compare two worksheets in excel to find new/updated records using vba. (assume worksheet 1 is old, and worksheet 2 has the potential new/updated entries)

These sheets have very similar information stored in each, just in a different order.

For example: Worksheet 1 has Street Address in Column E whereas Worksheet 2 has the street Address in Column H. There are many other columns like this.

I'm not really sure where to start. I tried to rearrange the columns in the second sheet by cutting and inserting to match those of the first, but that got out of hand very quickly.

Also, if its a new record, it needs be appended to the end of the data.

1
vbaexcel
Does each sheet have column headings that will allow 'matching' the corresponding columns? Have you tried anything in VBA? If a field differs, or a row is inserted or deleted, then what do you want to happen? 'appended to the end' of where? - Wayne G. Dunn
The columns are named differently, but could be changed to the same column names in worksheet 1 if that would make things easier. I would be comparing Worksheet 2 against Worksheet 1. I would like a new sheet to be made with the updates(if any) made to the rows and new entries appended to the bottom of the last row. I also would like this new sheet to maintain the same format as Worksheet 1. - Jerms3033
Since this is Excel, you certainly require something to indicate matching columns in the two worksheets -- the easiest, of course, being columns in the same order; second choice using identical column names. Next comes the order of the rows - are they sorted on one or more columns? Yes, you could use brute force to check if a row does or does not exist between the two sheets, but that's a pain. Finally, how do you want to indicate a field is different between the sheets, or if a row is deleted? I have code to compare two sheets that could be modified - depending on your answers. - Wayne G. Dunn
The rows are sorted on only one column. Lets call it "site code". If a cell to the right of sitecode differs in the two worksheets, it needs to be updated to whatever its value in worksheet2 is. There should also be no deletions, only updates and insertions. If a row is in worksheet1 and not in worksheet2, just skip it. - Jerms3033

1 Answers

0
votes

**Updated to allow defining the 'key' column. Just change the line 'iKeyCol = 2' to the desired column.

Here is some code to try. I was too lazy to rework all the code I was using, so some of this may be extra for you. Make sure your workbook 1. Has at least three sheets (names 'Sheet1, Sheet2, NewSheet') 2. Has column headers for Sheet1 & Sheet2 3. Col1 must match in both sheets 4. Column count must match in both sheets. Other that col1, other columns can be in any order.

Paste the code into a new module and the execute.

Let me know if you have a problem.

Option Explicit

' This module will compare differences between two worksheets.

Sub Compare106thWorksheets()
Dim iKeyCol     As Integer

'>>>> CHANGE THE FOLLOWING LINE TO IDENTIFY THE KEY COLUMN
iKeyCol = 2


Dim i, i2, i3   As Integer
Dim iRow        As Long
Dim iR1, iR2    As Long
Dim iC1, iC2    As Integer
Dim iColMap(30) As Integer
Dim iCol1, iCol2        As Integer
Dim LastRow1    As Long, LastRow2 As Long
Dim LastCol1    As Integer, LastCol2 As Integer
Dim MaxRow1     As Long
Dim MaxCol1     As Integer
Dim sFld1       As String, sFld2 As String
Dim sFN1, sFN2  As String
Dim rptWB       As Workbook
Dim DiffCount   As Long
Dim iLastRow, iLastColumn    As Integer
Dim strDeleted, strInserted As String
Dim ws1         As Worksheet
Dim ws2         As Worksheet
Dim wsChg       As Worksheet
Dim iCHGRows    As Long
Dim iCHGCols    As Long


Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set wsChg = ThisWorkbook.Worksheets("NewSheet")

With ws1.UsedRange                  ' Get used range of Sheet1
    LastRow1 = .Rows.Count
    LastCol1 = .Columns.Count
End With

With ws2.UsedRange                  ' Get used range of Sheet1
    LastRow2 = .Rows.Count
    LastCol2 = .Columns.Count
End With

With wsChg.UsedRange                  ' Get used range of Sheet1
    iCHGRows = .Rows.Count
    iCHGCols = LastCol1
End With

MaxRow1 = LastRow1
MaxCol1 = LastCol1

Debug.Print ws1.Name & " has " & LastRow1 & " rows and " & LastCol1 & " columns."
Debug.Print ws2.Name & " has " & LastRow2 & " rows and " & LastCol2 & " columns."

If MaxRow1 < LastRow2 Then MaxRow1 = LastRow2
If MaxCol1 < LastCol2 Then MaxCol1 = LastCol2

' Build a column map. Require both sheets to have the same names - but different order.
For i = 1 To 30
    iColMap(i) = 0
Next i
For iC1 = 1 To MaxCol1
    For i = 1 To LastCol2
        If ws1.Cells(1, iC1) = ws2.Cells(1, i) Then
            iColMap(iC1) = i
            Exit For
        End If
    Next i
Next iC1

' Check if any column headers failed to match.
For i = 1 To MaxCol1
    If iColMap(i) = 0 Then
        MsgBox "Column named '" & ws1.Cells(1, i) & " not found in Sheet2. Please correct and start again."
        GoTo Exit_Code
    End If
Next i

strDeleted = "": strInserted = ""
iR2 = 1
DiffCount = 0

For iR1 = 1 To MaxRow1

    If ws1.Cells(iR1, iKeyCol) <> ws2.Cells(iR2, iKeyCol) Then      ' Cell is different - is it an ADD or Delete?
        Debug.Print "Row: " & iR1 & vbTab & ws1.Cells(iR1, iKeyCol) & vbTab & "versus: " & ws2.Cells(iR2, iKeyCol)
        sFld1 = Trim(ws1.Cells(iR1, iKeyCol).FormulaLocal)
        sFld2 = Trim(ws2.Cells(iR2, iKeyCol).FormulaLocal)

        If sFld1 < sFld2 Then
            Debug.Print "Deleted Row " & ws1.Cells(iR1, iKeyCol)
            DiffCount = DiffCount + 1
            wsChg.Cells(DiffCount, iKeyCol) = "Deleted:"
            wsChg.Cells(DiffCount, 2) = ws1.Cells(iR1, iKeyCol)
            strDeleted = strDeleted & ws1.Cells(iR1, iKeyCol) & vbCrLf
            iCHGRows = iCHGRows + 1
            wsChg.Cells(iCHGRows, 1) = Now()
            For i = 1 To LastCol1
                wsChg.Cells(iCHGRows, i + 1) = ws1.Cells(iR1, i)
            Next i
            ws1.Rows(iR1).EntireRow.Delete
            iR1 = iR1 - 1
            GoTo Its_OK

        ElseIf sFld1 > sFld2 Then
            Debug.Print "Inserted Row " & ws2.Cells(iR1, iKeyCol)
            Debug.Print "R1: " & iR1 & " R2: " & iR2 & vbTab & ws1.Cells(iR1, iKeyCol) & vbTab & "versus: " & ws2.Cells(iR2, iKeyCol)
            DiffCount = DiffCount + 1
            strInserted = strInserted & ws2.Cells(iR2, iKeyCol) & vbCrLf
            ws1.Rows(iR1).EntireRow.Insert
            For i = 1 To LastCol1
                ws1.Cells(iR1, i) = ws2.Cells(iR2, iColMap(i))
            Next i

            iR2 = iR2 + 1

            GoTo Its_OK

        Else
            iR2 = iR2 + 1
        End If
    Else                ' Values are the same
        iR2 = iR2 + 1
    End If

Its_OK:

Next iR1

Debug.Print "Deleted:"
Debug.Print strDeleted
Debug.Print "------------------------------------------------------------------"
Debug.Print "Inserted:"
Debug.Print strInserted
Debug.Print "------------------------------------------------------------------"

For iRow = 2 To LastRow2
    Application.StatusBar = "Comparing cells " & Format(iCol1 / MaxCol1, "0 %") & "..."
    For iCol1 = 1 To LastCol1
        iCol2 = iColMap(iCol1)
        sFld1 = ""
        sFld2 = ""
        On Error Resume Next
        sFld1 = ws1.Cells(iRow, iCol1).FormulaLocal
        sFld2 = ws2.Cells(iRow, iCol2).FormulaLocal
        On Error GoTo 0
        If sFld1 <> sFld2 Then
            Debug.Print "Row: " & iRow & vbTab & ws1.Cells(iRow, iCol1) & vbTab & "versus: " & ws2.Cells(iRow, iCol2)
            DiffCount = DiffCount + 1
            wsChg.Cells(DiffCount, 1) = ws1.Cells(iRow, iKeyCol)
            wsChg.Cells(DiffCount, 2) = ws1.Cells(1, iCol1)
            wsChg.Cells(DiffCount, 3) = sFld1
            wsChg.Cells(DiffCount, 4) = sFld2
            ws1.Cells(iRow, iCol1).FormulaLocal = ws2.Cells(iRow, iCol2).FormulaLocal
        End If
    Next iCol1
Next iRow


wsChg.Activate
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(MaxRow1, MaxCol1))
    .Interior.ColorIndex = 19
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    On Error Resume Next
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
    "Compare " & ws1.Name & " with " & ws2.Name

Exit_Code:
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub