Insert extra columns to match a fixed predefined header row-CodePudding

Problem- In an excel file which is received monthly, sometimes few columns are found missing due to manual input. So what is done currently to maintain consistency is that a fixed set of column headers is kept as the master set in an old separate worksheet and whenever the new file is received, headers of the new file and old master set are matched and whatever column is found missing in the received new file, a new column is inserted and the header name is placed from the master list, the column is left blank just with the header.

Example- Master list of columns and headers- A B C D E F G H New list of of column and headers- A B D F G H

So here column headers C,E are missing so we need to insert one columns after B and D and write headers also.

Current code-



Header_New = NewFile.Sheets(1).Rows(1).Value
Header_Old = OldFile.Sheets(1).Rows(10).Value
For Count = 1 to 100 ' let's assume there are 100 columns in Old 
  If Header_New(1, Count) <> Header_Old(1, Count) then

?? now what best to do to Header_New/NewFile??

  End if 
Next

Thank you for any help.

CodePudding user response：

Update Columns

In the destination worksheet, will sort the columns in the order found in the source worksheet. Missing columns will be added only containing the respective header.

Option Explicit

Sub UpdateColumns()
    
    Const sRow As Long = 10
    Const dRow As Long = 1
    
    Dim sws As Worksheet: Set sws = OldFile.Worksheets(1)
    Dim slCell As Range
    Set slCell = sws.Rows(sRow).Find("*", , xlFormulas, , , xlPrevious)
    If slCell Is Nothing Then Exit Sub
    Dim scCount As Long: scCount = slCell.Column
    Dim srg As Range: Set srg = sws.Rows(sRow).Resize(, scCount)
    Dim dws As Worksheet: Set dws = NewFile.Worksheets(1)
    
    Application.ScreenUpdating = False
    
    Dim sCell As Range
    Dim sc As Long
    Dim dIndex As Variant
    Dim drg As Range
    
    For sc = scCount To 1 Step -1
        Set sCell = srg.Cells(sc)
        Set drg = dws.Rows(dRow).Resize(, scCount * 2)
        dIndex = Application.Match(sCell, drg, 0)
        If IsNumeric(dIndex) Then
            dws.Columns(dIndex).Cut
            drg.Cells(1).EntireColumn.Insert Shift:=xlShiftToRight
        Else
            drg.Cells(1).EntireColumn.Insert Shift:=xlShiftToRight
            drg.Cells(1).Offset(, -1).Value = sCell.Value
        End If
    Next sc

    Application.ScreenUpdating = True
    
    MsgBox "Columns updated.", vbInformation

End Sub