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

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
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"

VBA Code:
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
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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
 
Solution

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Just some feedback..
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
What makes you say
VBA Code:
    '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

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile

ADVERTISEMENT

How about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
Just some feedback..
VBA Code:
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 !!
 

Watch MrExcel Video

Forum statistics

Threads
1,130,112
Messages
5,640,160
Members
417,128
Latest member
Xianter

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top