Compare Two Sheets Headers and return mismatching Values in Both

I have two Sheets NewSheet and Old Sheet their headers (first rows) shoud be identical but actually the are not for example :

So the code should return in msgbox show mismatch Cell address and cell value in both sheets

Old Sheet Mismatch : Cell C1 Value C , Cell E1 Value E

NewSheet Mismatch : Cell D1 Value F , Cell E1 Value G

I've made alot of trial but all away from the target. Your help is highly appreciated

This is one of the trial adapting code from googling :

    Sub HeaderCompare2(ByVal oldWbPath As String, ByVal newWbPath As String)

    Dim wbOld As Workbook, wbNew As Workbook
        
    Dim rngOld As Range, rngNew As Range, c As Range, FoundRange As Range

    Dim msg As String
    
    Set wbOld = Workbooks.Open(Filename:=oldWbPath)
    Set wbNew = Workbooks.Open(Filename:=newWbPath)
    
    Set rng1 = wbOld.Worksheets("TRAIN-D").Range("A1:BP1")
    Set rng2 = wbNew.Worksheets("TRAIN-D").Range("A1:BP1")

    Dim iRow As Integer
    iRow = 1
    
    For Each rng1cell In rng1
        For Each rng2cell In rng2
            If rng1cell <> rng2cell Then
                
                msg = msg & rng1cell
                iRow = iRow + 1
            End If
        Next rng2cell
    Next rng1cell

    MsgBox msg


End Sub

The Sheets are in two different workbooks where i pass their path to the function HeaderCompare2

Please, try this fancy way. It uses only arrays (matching them in different ways) and a single iteration only for the two ways/sheets for returning:

Sub MatchHeaders()
 Dim wsOld As Worksheet, wsNew As Worksheet, lastCol As Long, arrO, arrN, arrMtch, mtch
 
 Set wsOld = ActiveSheet 'use here your Old sheet
 Set wsNew = wsOld.Next  'use here your New sheet (now, this new sheet is after the old one...)
 lastCol = wsOld.cells(1, wsOld.Columns.count).End(xlToLeft).column 'last header column
 arrO = wsOld.Range("A1", wsOld.cells(1, lastCol)).Value2 place the headers in an array
 With Application
    arrO = .Transpose(.Transpose(arrO)) 'the array to become 1D type
 End With
 
 lastCol = wsNew.cells(1, wsNew.Columns.count).End(xlToLeft).column
 arrN = wsNew.Range("A1", wsNew.cells(1, lastCol)).Value2
  With Application
    arrN = .Transpose(.Transpose(arrN)) 'the array to become 1D type
 End With
 
 Dim strMissing As String, i As Long
 For i = 1 To 2
    If i = 1 Then 'processing and returning for the Old sheet:
        arrMtch = Application.IfError(Application.match(arrO, arrN, 0), 0) 'it adds 0 instead of  not matching headers (returning error)
    Else 'processing and returning for the New sheet header:
        arrMtch = Application.IfError(Application.match(arrN, arrO, 0), 0)
    End If
    strMissing = "Missing from " & IIf(i = 1, "OldHeader", "NewHeader") & ":"
    Do
       mtch = Application.match(0, arrMtch, 0)
       If IsError(mtch) Then Exit Do
       strMissing = strMissing & vbCrLf & arrO(mtch)
       arrMtch(mtch) = "X" 'replacing 0, used only to match the missing match!
    Loop
    Debug.Print strMissing
    MsgBox strMissing
 Next i
End Sub

This was the principle/logic of working.

Here it is your adapted code:

Sub HeaderCompare2(ByVal oldWbPath As String, ByVal newWbPath As String)
    Dim wbOld As Workbook, wbNew As Workbook
    Dim rngOld As Range, rngNew As Range, arrO, arrN, arrMtch, mtch

    Dim msg As String
    
    Set wbOld = Workbooks.Open(FileName:=oldWbPath)
    Set wbNew = Workbooks.Open(FileName:=newWbPath)
    
    Set rng1 = wbOld.Worksheets("TRAIN-D").Range("A1:BP1")
    Set rng2 = wbNew.Worksheets("TRAIN-D").Range("A1:BP1")
    arrO = rng1.Value2:  arrN = rng2.Value2
    
    With Application
       arrO = .Transpose(.Transpose(arrO)) 'to become 1D array
       arrN = .Transpose(.Transpose(arrN)) 'to become 1D array
    End With
    
    Dim strMissing As String, i As Long
    For i = 1 To 2
       If i = 1 Then
           arrMtch = Application.IfError(Application.match(arrO, arrN, 0), 0)
       Else
           arrMtch = Application.IfError(Application.match(arrN, arrO, 0), 0)
       End If
       strMissing = "Missing from " & IIf(i = 1, "OldHeader", "NewHeader") & ":"
       Do
          mtch = Application.match(0, arrMtch, 0)
          If IsError(mtch) Then Exit Do
          strMissing = strMissing & vbCrLf & arrO(mtch)
          arrMtch(mtch) = "X"
       Loop
       Debug.Print strMissing
       MsgBox strMissing
    Next i
End Sub

And your classic VBA code can be adapted in the next way:

Sub HeaderCompare2(ByVal oldWbPath As String, ByVal newWbPath As String)

    Dim wbOld As Workbook, wbNew As Workbook
    Dim rngOld As Range, rngNew As Range, c As Range, mtch
    Dim msgOld As String, msgNew As String
    
    Set wbOld = Workbooks.Open(FileName:=oldWbPath)
    Set wbNew = Workbooks.Open(FileName:=newWbPath)
    
    Set rng1 = wbOld.Worksheets("TRAIN-D").Range("A1:BP1")
    Set rng2 = wbNew.Worksheets("TRAIN-D").Range("A1:BP1")
    
    msgOld = "Old Sheet Mismatch :"
    msgNew = "New Sheet Mismatch :"
    For Each c In rng1
        mtch = Application.match(c.Value, rng2, 0)
        If IsError(mtch) Then _
         msgOld = msgOld & vbCrLf & c.address & " Value " & c.Value
    Next rng1cell
    For Each rng2cell In rng2
        mtch = Application.match(c.Value, rng1, 0)
        If IsError(mtch) Then _
         msgNew = msgNew & vbCrLf & c.address & " Value " & c.Value
    Next rng2cell
    MsgBox msgOld & vbCrLf & msgNew

End Sub

Not tested the adaptations, but this should be a good logic and most probably they will work as it should.

If something not clear, do not hesitate to ask for clarification. If an error occurs, please mention what error and on which code line.