Ctrl find, copy and pasting help please (Macro code needed)

Hi

I attach two spreadsheets, one is "Excel Spreadsheet Header Row_1.xlsx" which is a fixed header row that has to stay in the order on the sheet. The other spreadsheet is a variable spreadsheet which changes month to month "example.xlsx". I need the data from the example.xlsx to be copy and pasted into the excel spreadsheet but not all header row items are used.

My problem is when I search for "Salary Adj", because its not in the example.xlsx the macro stops working and I need a bit of code to rectify it. So If the column "Salary Adj" has no data in the example sheet then I want zero's in the cells within the column with the header "Salary Adj" in the Excel Spreadsheet Header Row.xlsx"

Here is a selection of the code below:

Sub parttwo()
    
    
    Workbooks.Open Filename:= _
        "N:\PAYROLL\Leanne\Private - Macro Work LB only\Excel Spreadsheet Header Row_1.xlsx"
    
    'Need to sort this out because it can't find sal adj its displaying an error
    
   
    Range("S2").Select
    Cells.Find(What:="Salary Adj", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range("T2").Select
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Microsoft Sans Serif"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 3
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 3
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.NumberFormat = "0.00"
    ActiveCell.FormulaR1C1 = "0"
    Range("T2").Select
    Selection.Copy
    Range("T2:T30").Select
    ActiveSheet.Paste

Not sure that I put the complete piece of the code in, so for car allowance the same thing happens as below

 Windows("example.xlsx").Activate
    Range("V30").Select
    
    'same for this as car allow and sal adj
    Cells.Find(What:="Holiday Pay", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Windows("Excel Spreadsheet Header Row_1.xlsx").Activate
    Cells.Find(What:="Holiday Pay", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range("W2").Select
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Microsoft Sans Serif"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 3
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 3
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.NumberFormat = "0.00"
    ActiveCell.FormulaR1C1 = "0"
    Range("W2").Select

I have a question for you - is there any specific reason why you are searching the entries from excel spreadsheet.... in example file and not vice versa? You can search for all the columns from example in the big file and then copy the data. Whichever columns are not found, you can choose to put a 0 or leave blank. What do you say?

You have mentioned that the example file changes each time. Do the headers change too? Or just that today there might be data in 5 columns and the next time 8?

Ok, since its all inclusive, it will be better to search the headers from the example file in the excel file and not vice-versa. This way, you will not get errors. And incase there are some fields which are not populated, we can have the macro key in blanks or 0.

Once the header is found, the entire column can be copied right away. You do not need to go row wise, so this can avoid possible errors.

I am working out something for you. I have a question. When the data is found, should it be copied to the next available row in the excel spreadsheet or just below the header?

Am working on something. Getting an error. Will provide you the code soon.

Use this code -

Option Explicit
Dim WeeklyFN As String
Dim MainFN As String
Dim MFile As String
Dim lrow As Long
Dim sfield As String
Dim cellcol As Long
Dim i As Long
Dim lastrow As Long
Dim c As Object

Sub find_cols()

MFile = ActiveWorkbook.Name
Application.ScreenUpdating = False
proceed:
WeeklyFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please open the Weekly file")
If WeeklyFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed
Else
    Workbooks.Open Filename:=WeeklyFN
    WeeklyFN = ActiveWorkbook.Name
End If

proceed1:
MainFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please open the Main file")
If MainFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed1
Else
    Workbooks.Open Filename:=MainFN
    MainFN = ActiveWorkbook.Name
End If

Workbooks(MFile).Worksheets("Sheet1").Columns("A:A").Delete
Workbooks(WeeklyFN).Worksheets("Sheet1").Rows("1:1").Copy
Workbooks(MFile).Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Application.CutCopyMode = False

lrow = Workbooks(MFile).Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lrow
    sfield = Workbooks(MFile).Worksheets("Sheet1").Range("A" & i).Value
    
    Workbooks(MainFN).Worksheets("Sheet1").Range("A2").Select
    On Error Resume Next
    Workbooks(MainFN).Worksheets("Sheet1").Rows("1:1").Find(What:=sfield, After:=Range("A1"), LookIn:=xlValues, Lookat:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, searchformat:=False).Activate
    On Error GoTo 0
    cellcol = ActiveCell.Column
    
    lastrow = Workbooks(WeeklyFN).Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    With Workbooks(WeeklyFN).Worksheets("Sheet1")
        .Range(.Cells(2, i), .Cells(lastrow, i)).Copy Workbooks(MainFN).Worksheets("Sheet1").Cells(2, cellcol)
    End With
       
    Application.CutCopyMode = False
Next i

End Sub

Just for your information - i didnt find the "Branch" field in the Excel Spreadsheet. There could be a few more like that but the code ignores them. Try this code and let me know if the fields have been copied properly. You are the best judge of that.