VBA - How to match headers from two different sheet to make sure they are same name and at same order?

Viewed 1217

I have two excel sheet ReportOld and ReportNew, what I want to check and make sure all the column herder from both sheets are matching name and in same order. Basically need to check there should not be any new column added or removed from last report.. bot are identical.

Till now I tried the code is:

Sub colLookup()

Dim ShtOne As Worksheet, ShtTwo As Worksheet
Dim shtOneHead As Range, shtTwoHead As Range
Dim headerOne As Range, headerTwo As Range
Dim x As Integer
Dim lastCol As Long

Set ShtOne = Sheets("ReportOld")
Set ShtTwo = Sheets("ReportNew")

lastCol = ShtOne.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtOneHead = ShtOne.Range("A1", ShtOne.Cells(1, lastCol))

lastCol = ShtTwo.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtTwoHead = ShtTwo.Range("A1", ShtTwo.Cells(1, lastCol))

For Each headerTwo In shtTwoHead
    For Each headerOne In shtOneHead
        If headerTwo.Value = headerOne.Value Then

        Else
        x = MsgBox("Headers are not matching in both sheets.")
        MsgBox "value is:" & headerTwo.Value
        Exit Sub
        End If
    Next headerOne
 Next headerTwo
End Sub    
2 Answers

Try this code. It counts the headings on both sheets and fills an array of headings from both sheets. Then it compares the headings one each sheet and displays a message if the headings don't match. It then compares the number of columns and if they don't match, another message is displayed...

Sub colLookup()

Dim ShtOne As Worksheet, ShtTwo As Worksheet
Dim shtOneHead As Range, shtTwoHead As Range
Dim headerOne As Range, headerTwo As Range
Dim x As Integer
Dim lastCol As Long

Set ShtOne = Sheets("ReportOld")
Set ShtTwo = Sheets("ReportNew")

lastCol = ShtOne.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtOneHead = ShtOne.Range("A1", ShtOne.Cells(1, lastCol))

lastCol = ShtTwo.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtTwoHead = ShtTwo.Range("A1", ShtTwo.Cells(1, lastCol))

For Each headerTwo In shtTwoHead
    For Each headerOne In shtOneHead
        If headerTwo.Value = headerOne.Value Then

        Else
        x = MsgBox("Headers are not matching in both sheets.")
        MsgBox "value is:" & headerTwo.Value
        Exit Sub
        End If
    Next headerOne
 Next headerTwo
End Sub

Sub new_code()

    Dim a As Integer
    Dim b As Integer
    Dim x As Integer
    Dim HeadNew As Integer
    Dim HeadOld As Integer
    Dim HeadingsNew() As String
    Dim HeadingsOld() As String

    a = 1
    b = 1
    HeadNew = 0
    HeadOld = 0

    Erase HeadingsNew
    Erase HeadingsOld


    Worksheets("ReportNew").Activate

    Do Until Len(Trim(Cells(1, a))) = 0

        DoEvents

        ReDim Preserve HeadingsNew(1 To a)
        HeadingsNew(a) = Trim(Cells(1, a))

        a = a + 1
    Loop

    a = a - 1
    HeadNew = a

    Worksheets("ReportOld").Activate

    Do Until Len(Trim(Cells(1, b))) = 0

        DoEvents

        ReDim Preserve HeadingsOld(1 To b)
        HeadingsOld(b) = Trim(Cells(1, b))

        b = b + 1
    Loop

    b = b - 1
    HeadOld = b

    x = 1

    Do Until x > a

        DoEvents

        If HeadingsNew(x) <> HeadingsOld(x) Then

            MsgBox " Headings are different" & Chr(10) & Chr(10) & _
            " column number " & x & Chr(10) & _
            " ReportNew:  " & (HeadingsNew(x)) & Chr(10) & _
            " ReportOld:  " & (HeadingsOld(x)), vbCritical, "Data Issue"

       End If

       x = x + 1

    Loop

    If HeadOld <> HeadNew Then
        MsgBox "  The number of headings don't match", vbcritacal, "Data Issue"
    End If


End Sub

I suggest a variant array. Here is a simple solution.

Sub Compare()

Dim header1 As Variant, header2 As Variant, i as long
header1 = sheets("ReportOld").Rows(1).Value
header2 = sheets("ReportNew").Rows(1).Value

For i = 1 To 100000
    If header1(1, i) <> vbNullString Then
        If header1(1, i) <> header2(1, i) Then
            MsgBox "Compare Failed at column " & i
            Exit For
        End If
    Else
        MsgBox "Compare ="
        Exit For
    End If
Next i

End Sub 
Related