Remove columns based on headers, using array created from headers from another table

[radsok8199]

Dear VBA Masters. Below u will find code I am trying to run but I got lost. I do write this as begginer using tutorials but can not find solution of what i am doing wrong.
I do have 2 similar tables placed on separate worksheets of same workbook. First sheet "Jobs" contains requirements and another "Extract" contains table from DB Extract. Both tables almost same with Headers matching each other. However table contains some extra columns i want to be removed. Amount of columns in both sheets are flexible so range need to be dynamic.

So to summarize: I want my code to use headers from "Extract" as Array and check column Headers from sheet "Jobs". If values match ( headers) then keep column if not then remove column from "Jobs"

Headers are placed in first row for both tables and begins from "D1"

Sub removeColTest()

    Dim Firstcol As Long
    Dim Lastcol As Long
    Dim Lcol As Long
    Dim Head As Variant
    Dim Mylist As Variant
    Dim CalcMode As Long

    Head = Application.Index(Sheets("Extract").Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)
    Mylist = Array(Head)

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With Worksheets("Jobs")

        Firstcol = .UsedRange.Cells(0).Column
        Lastcol = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        For Lcol = Lastcol To Firstcol Step -1
      
            With .Cells(1, Lcol)
           
        If Not IsNumeric(WorksheetFunction.Match(Cells(1, Lcol), Mylist, 0)) Then Columns(Lcol).EntireColumn.Delete
           
            End With
        Next Lcol
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

 

[Fluff]

How about

Sub removeColTest()

    Dim Firstcol As Long
    Dim Lastcol As Long
    Dim Lcol As Long
    Dim Head As Variant
    Dim Mylist As Variant
    Dim CalcMode As Long

    Head = Application.Index(Sheets("Extract").Range("A1", Sheets("Extract").Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With Worksheets("Jobs")

        Firstcol = .UsedRange.Cells(1).Column
        Lastcol = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        For Lcol = Lastcol To Firstcol Step -1
     
          
        If Not IsNumeric(Application.Match(.Cells(1, Lcol).Value, Head, 0)) Then .Columns(Lcol).EntireColumn.Delete
          
        Next Lcol
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

 

[kanadaaa]

Just some feedback..

Sub removeColTest()

    Dim Firstcol As Long
    Dim Lastcol As Long
    Dim Lcol As Long
    Dim Head As Variant
    Dim Mylist As Variant
    Dim CalcMode As Long

    Head = Application.Index(Sheets("Extract").Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)
    Mylist = Array(Head) 'Head is an array in itself; so this variable is redundant and making the procedure complex

    'These are not necessary (although Application.ScreenUpdating often comes in handy)
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    '==============

    With Worksheets("Jobs")

        Firstcol = .UsedRange.Cells(0).Column 'Error 1004 because there's no such cell as Cells(0) in UsedRange
        Lastcol = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        For Lcol = Lastcol To Firstcol Step -1
     
            With .Cells(1, Lcol) 'Redundant
          
                If Not IsNumeric(WorksheetFunction.Match(Cells(1, Lcol), Mylist, 0)) Then Columns(Lcol).EntireColumn.Delete
                'Mylist needs to be Head (maybe a FOR loop is needed to pull out elements from Head since it's an array?)
          
            End With '''''''''
        Next Lcol
    End With

    With Application 'Unnecessary
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

 

[Fluff]

What makes you say

    'These are not necessary (although Application.ScreenUpdating often comes in handy)
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

This can speed up the code.
Also using the Match works quite happily, without the need for nested loops.

 

[radsok8199]

How about

Sub removeColTest()

    Dim Firstcol As Long
    Dim Lastcol As Long
    Dim Lcol As Long
    Dim Head As Variant
    Dim Mylist As Variant
    Dim CalcMode As Long

    Head = Application.Index(Sheets("Extract").Range("A1", Sheets("Extract").Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With Worksheets("Jobs")

        Firstcol = .UsedRange.Cells(1).Column
        Lastcol = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        For Lcol = Lastcol To Firstcol Step -1
    
         
        If Not IsNumeric(Application.Match(.Cells(1, Lcol).Value, Head, 0)) Then .Columns(Lcol).EntireColumn.Delete
         
        Next Lcol
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

Thank You Almost lost on it and i was so close Thanks I can understand what i was doing wrong.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[radsok8199]

Just some feedback..

Sub removeColTest()

    Dim Firstcol As Long
    Dim Lastcol As Long
    Dim Lcol As Long
    Dim Head As Variant
    Dim Mylist As Variant
    Dim CalcMode As Long

    Head = Application.Index(Sheets("Extract").Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)
    Mylist = Array(Head) 'Head is an array in itself; so this variable is redundant and making the procedure complex

    'These are not necessary (although Application.ScreenUpdating often comes in handy)
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    '==============

    With Worksheets("Jobs")

        Firstcol = .UsedRange.Cells(0).Column 'Error 1004 because there's no such cell as Cells(0) in UsedRange
        Lastcol = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        For Lcol = Lastcol To Firstcol Step -1
    
            With .Cells(1, Lcol) 'Redundant
         
                If Not IsNumeric(WorksheetFunction.Match(Cells(1, Lcol), Mylist, 0)) Then Columns(Lcol).EntireColumn.Delete
                'Mylist needs to be Head (maybe a FOR loop is needed to pull out elements from Head since it's an array?)
         
            End With '''''''''
        Next Lcol
    End With

    With Application 'Unnecessary
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

Thank you for your feedback. I appreciate every line of comments. All feedback is important for me on my way to learn VBA !!