VBA Code to delete column based on headers not equal to

[Chazzo]

Hello All,

I'd like to get thoughts on the most efficient vba code that will search a row of headers in a sheet and then delete the entire column if it is not equal to a list of values.

For example, in the header row below where there are Football teams, i would like to delete the entire column if the teams are not equal to the Buffalo Bills, New York Jets, and Cleveland Browns.

Let's say that the Buffalo Bills is in cell B2.

Currently I do not have any code because I'm looking for thoughts on the best methods to use in a scenario like this... my actual sheet will have roughly 200 columns, and i only need to keep 14 of them.

As always, any feedback with actual code would be greatly appreciated and I will test and provide feedback... thanks everyone!

Buffalo Bills	Miami Dolphins	New England Patriots	New York Jets	Baltimore Ravens	Cincinnati Bengals	Cleveland Browns	Pittsburgh Steelers
New York	Florida	Massachusetts	New Jersey	Maryland	Ohio	Ohio	Pennsylvania

 

[johnnyL]

This could be one way to do it:

Sub DeleteNonApprovedColumns()
'
    Dim HeaderColumn            As Long, HeaderRow                  As Long
    Dim FirstHeaderColumnNumber As Long, LastHeaderColumnNumber     As Long
    Dim TeamName                As String
'
    FirstHeaderColumnNumber = 2                                                     ' <--- Set this to the FirstHeaderColumnNumber
    HeaderRow = 2                                                                   ' <--- Set this to the Header row
'
    LastHeaderColumnNumber = Cells(HeaderRow, Columns.Count).End(xlToLeft).Column   ' LastHeaderColumnNumber
'
    For HeaderColumn = LastHeaderColumnNumber To FirstHeaderColumnNumber Step -1    ' Loop through the Header range
        TeamName = Cells(HeaderRow, HeaderColumn).Value                             '   Save the Header value into TeamName
'
        Select Case TeamName                                                        '   Check the TeamName found as a Header
            Case "Buffalo Bills", "New York Jets", "Cleveland Browns"               '       If approved name found, do nothing
            Case Else                                                               '       Else ...
                Columns(HeaderColumn).Delete                                        '           Delete the column
        End Select
    Next                                                                            ' Loop baack
End Sub

 

[Chazzo]

This could be one way to do it:

Sub DeleteNonApprovedColumns()
'
    Dim HeaderColumn            As Long, HeaderRow                  As Long
    Dim FirstHeaderColumnNumber As Long, LastHeaderColumnNumber     As Long
    Dim TeamName                As String
'
    FirstHeaderColumnNumber = 2                                                     ' <--- Set this to the FirstHeaderColumnNumber
    HeaderRow = 2                                                                   ' <--- Set this to the Header row
'
    LastHeaderColumnNumber = Cells(HeaderRow, Columns.Count).End(xlToLeft).Column   ' LastHeaderColumnNumber
'
    For HeaderColumn = LastHeaderColumnNumber To FirstHeaderColumnNumber Step -1    ' Loop through the Header range
        TeamName = Cells(HeaderRow, HeaderColumn).Value                             '   Save the Header value into TeamName
'
        Select Case TeamName                                                        '   Check the TeamName found as a Header
            Case "Buffalo Bills", "New York Jets", "Cleveland Browns"               '       If approved name found, do nothing
            Case Else                                                               '       Else ...
                Columns(HeaderColumn).Delete                                        '           Delete the column
        End Select
    Next                                                                            ' Loop baack
End Sub

This could be one way to do it:

Sub DeleteNonApprovedColumns()
'
    Dim HeaderColumn            As Long, HeaderRow                  As Long
    Dim FirstHeaderColumnNumber As Long, LastHeaderColumnNumber     As Long
    Dim TeamName                As String
'
    FirstHeaderColumnNumber = 2                                                     ' <--- Set this to the FirstHeaderColumnNumber
    HeaderRow = 2                                                                   ' <--- Set this to the Header row
'
    LastHeaderColumnNumber = Cells(HeaderRow, Columns.Count).End(xlToLeft).Column   ' LastHeaderColumnNumber
'
    For HeaderColumn = LastHeaderColumnNumber To FirstHeaderColumnNumber Step -1    ' Loop through the Header range
        TeamName = Cells(HeaderRow, HeaderColumn).Value                             '   Save the Header value into TeamName
'
        Select Case TeamName                                                        '   Check the TeamName found as a Header
            Case "Buffalo Bills", "New York Jets", "Cleveland Browns"               '       If approved name found, do nothing
            Case Else                                                               '       Else ...
                Columns(HeaderColumn).Delete                                        '           Delete the column
        End Select
    Next                                                                            ' Loop baack
End Sub
[/CODE
[/QUOTE]

 

[Chazzo]

johnnyL

Thank you!

This is a great solution and thank you for adding comments to explain the variables and how each line of code is executing.

I tested this on my actual file which has 207 columns and it only took 4 seconds to execute which is fantastic.

Thanks again for the solution.

-Chazzo

 

[johnnyL]

Glad to help. I will take another look at it shortly, how many rows do you have?

 

[Chazzo]

The row

Glad to help. I will take another look at it shortly, how many rows do you have?

The row count is variable, usually around 100-200k.

It is a download which is exported from tableau and opens as a .csv file.

What I’m doing is deleting 193 of the 207 columns and then copy/pasting the 14 columns into another workbook to feed a dashboard.