Loop through a range to Find different values to Copy a target column

[DENomad]

Hi Gurus,
I am creating a macro to do a '.Find', Copy and Paste the entire column from one sheet to another. However, I have run into a little problem that I am struggling to solve and hope someone can help me out with my issue.
Macro Requirements:
1. Sheet 'Index' -
1.1 Column Name 1: This is the main column where the macro will use the value from the column to search for in header in the 'Raw' sheet.
1.2 Column Name 2 to last column: If the value from Column Name 1 is not found to be a header name in the 'Raw' sheet, then the value from Column Name 2 will be used for the search, and if the value from Column Name 2 is not found to be a header name in the 'Raw' sheet, the next value in the row will be used until the last column value has been used. eg. If range(B2) is not found in Sheet 'Raw'.range(A1:I1), then use the value from range(C2), etc.
1.3 Column A named 'Column number' confirms the order in which the columns are copied from the 'Raw' sheet to the 'Template' sheet.
1.4 Identify any unknown header in Sheet 'Raw' that is not in Sheet 'Index'. This could be a pre-step before the macro runs with a message box informing the user there is a header that is not in Sheet 'Index'.

2. Sheet 'Raw'
2.1 This is the sheet where the raw data will be paste into before the macro is run. The headers will never be the same and will change in order without notice.

3. Sheet 'Template'
3.1 When the header from Column Name 1 is found in Sheet 'Raw' the column is copied and pasted into Sheet 'Template' in the order it's in Sheet 'Index'.

Public val_1 As Variant, Val_2 As Variant
Public valrng As Range

'**** This sub goes through all the column names and assign it to the _****
'**** public variable val_1 to be passed to sub MyHeader              ****

Sub myIndex()

Dim lastrow As Long
Dim Col_x As Worksheet
Dim r As Range

Set Col_x = ThisWorkbook.Sheets("Index")

lastrow = Col_x.Cells(Rows.Count, 2).End(xlUp).Row

Set r = Col_x.Range("B2:B" & lastrow)

With r
    For Each Cell In r
    
    Set valrng = ThisWorkbook.Sheets("Index").Range(Cell.Address)
    
        val_1 = Cell.Value
        Val_2 = valrng.Offset(0, 1).Value
        
            Call MyHeader
    Next Cell

End With

End Sub

'**** This sub copies the data from sheet Raw to sheet Template ****

Sub MyHeader()

Dim SelRange As Range, rng As Range, valrng As Range
Dim ColNum As Integer
Dim CWS As Worksheet, TmpWS As Worksheet
Dim LastCol As Long

Set CWS = ThisWorkbook.Sheets("Raw")


'Find the column number where the column header is as per val_1
With CWS
    If .Cells.Find(What:=val_1, After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows) Is Nothing Then
       .Cells.Find(What:=Val_2, After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).EntireColumn.Copy
    
    Else
        .Cells.Find(What:=val_1, After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).EntireColumn.Copy
    
    End If
    
End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set TmpWS = ThisWorkbook.Sheets("Template")
Set rng = TmpWS.Range("A1")
    
 LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
' Copy the column val_1 from sheet Raw to sheet Template
' If Cell A1 is not empty, paste val_1 into the next empty column
    With TmpWS
        If .Range("A1") = "" Then
            .Cells(1, Columns.Count).End(xlToLeft).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
            Else
      
            .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
        End If
    
    End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

TmpWS.Activate

End Sub

My issues:
1. I am unsure how to loop through the different values in the same row if the value in Column Name 1 is not found and to stop when it reaches the last column where the cell value is End*/*.
2. How to identify if there is an unknown column in Sheet 'Raw' to do the pre-check.

 

[DENomad]

Images of the tabs in the spreadsheet55
Sheet Index

Sheet Raw

Sheet Template

 

[DENomad]

I worked out what I needed to do, so here is that bit of code I'm using. It's working pretty well but I am sure it can be improved upon.

Public ws_1 As Worksheet
Public ws_Raw As Worksheet
Public ws_output As Worksheet
Public header As Variant
Public cell_3 As Variant
Public dType As Variant
Public sq As Long
Public StartMyTime As Double

'**********************************************************************************************************************
'** MyHeader copies the data from sheet ws_Raw_Data to sheet Output
'**********************************************************************************************************************

Sub MyHeader()

    Dim r As Range, rng As Range
    Dim lastrow As Long, lastrow1 As Long, LastCol As Long
    Dim i As Long, c As Long
    
Set ws_1 = ActiveWorkbook.Worksheets("Field_Mapping_Rules")
Set ws_Raw = ActiveWorkbook.Worksheets("Raw_Data")
Set ws_output = ActiveWorkbook.Worksheets("Output")
    
    StartMyTime = Timer
    
    lastrow = ws_1.Cells(Rows.Count, 2).End(xlUp).Row
    lastrow1 = ws_1.Cells(Rows.Count, 3).End(xlUp).Row
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ws_1.Activate
    
    With ws_Raw
    .Rows("1:1").NumberFormat = "General"
    
Set r = ws_1.Range("D2:D" & lastrow1)
        For Each cell_1 In r
        
                dType = cell_1.Offset(0, -2)
                
            If cell_1.Offset(0, -1) = "Y" Then
                header = cell_1.Value
                sq = cell_1.Offset(0, -3).Value
                    If .Cells.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False) Is Nothing Then
                        i = cell_1.Row
                        c = cell_1.Column
                        LastCol = ws_1.Cells(i, Columns.Count).End(xlToLeft).Column
                    Set rng = ws_1.Range(Cells(i, c), Cells(i, LastCol))
                        For Each cell_3 In rng
                            If cell_3 Is Nothing Then GoTo lastline
                            Call myfind
    
                        Next cell_3
                    Else
                    ws_Raw.Cells.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False).EntireColumn.Copy
                        Call myPaste
                    End If
            End If
lastline:
        Next cell_1
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Call myHeaderCopy
    
    End Sub