Delete Non-contiguous Columns in a Table, where Header is not "X,Y,Z" as a VBA script/Macro

[Heretical1]

Good Morning amazing people,

I'm hoping I have the title right and am hoping for some assistance as I am a relatively new excel user with a bit of a challenge.

I need a relatively simplified (eg easy to understand) VBA script that will delete all columns in a table that do not contain the headers X,Y,Z etc (I have about 9 column headers that I need to keep in a table)
I have read up on deleting from the right, Select Case, Union and Ranges and my head is still spinning slightly trying to put it all together.

Is there anyone that might be able to provide some assistance with the above, I would be eternally grateful.

 

[Zot]

I think the step with description clear enough

Sub DelColumn()

Dim Col As Long, LastCol As Long
Dim ColToDelete As Range
Dim ws As Worksheet

Application.ScreenUpdating = False

'Define working sheet
Set ws = ActiveWorkbook.Sheets("Sheet1")

'Find Last Column with Headers. Assuming all Headers are in row 1
LastCol = ws.Range("A1").End(xlToRight).Column

'Loop and group all columns to be deleted
For Col = LastCol To 1 Step -1                           'Loop from right to left
    Select Case Cells(1, Col)
        Case "X", "Y", "Z"                                         ' Don't do anything if these Headers are found
        
        Case Else
            If ColToDelete Is Nothing Then              'Initial execution when ColToDelete is still empty
                Set ColToDelete = ws.Columns(Col)
            Else
                Set ColToDelete = Application.Union(ColToDelete, ws.Columns(Col))
            End If
    End Select
Next

'Delete grouped columns if there is any
If Not ColToDelete Is Nothing Then
    ColToDelete.Delete
End If

End Sub

 

[Heretical1]

I think the step with description clear enough

Sub DelColumn()

Dim Col As Long, LastCol As Long
Dim ColToDelete As Range
Dim ws As Worksheet

Application.ScreenUpdating = False

'Define working sheet
Set ws = ActiveWorkbook.Sheets("Sheet1")

'Find Last Column with Headers. Assuming all Headers are in row 1
LastCol = ws.Range("A1").End(xlToRight).Column

'Loop and group all columns to be deleted
For Col = LastCol To 1 Step -1                           'Loop from right to left
    Select Case Cells(1, Col)
        Case "X", "Y", "Z"                                         ' Don't do anything if these Headers are found
       
        Case Else
            If ColToDelete Is Nothing Then              'Initial execution when ColToDelete is still empty
                Set ColToDelete = ws.Columns(Col)
            Else
                Set ColToDelete = Application.Union(ColToDelete, ws.Columns(Col))
            End If
    End Select
Next

'Delete grouped columns if there is any
If Not ColToDelete Is Nothing Then
    ColToDelete.Delete
End If

End Sub

This is great, thankyou so much. I notice that I get error 1004 " Delete method of Range class failed" if I run this against a Table.
It seems to work fine if I convert the Table back to Range.

What would I be missing from the above to cause the error?

 

[Zot]

I did not read carefully. You were talking about table. I've never use table in Excel actually. I guess deleting it is different.

I think this link will help

VBA Delete Column from Table in Excel |Tutorial |Examples | VBAF1.COM

VBA Delete Column from Table in Excel. We can Delete or remove a single Column or multiple Columns from Table at any position.

vbaf1.com

 

[Zot]

Forget about Union. Try this. See if this is what you need

Sub DelColumn()

Dim Col As Long, LastCol As Long
Dim ColToDelete As Range
Dim tbl As ListObject
Dim ws As Worksheet

Application.ScreenUpdating = False

'Define working sheet
Set ws = ActiveWorkbook.Sheets("Sheet1")

Set tbl = ws.ListObjects("Table1")

'Find Last Column with Headers. Assuming all Headers are in row 1
LastCol = ws.Range("A1").End(xlToRight).Column

'Loop and group all columns to be deleted
For Col = LastCol To 1 Step -1                           'Loop from right to left
    Select Case Cells(1, Col)
        Case "X", "Y", "Z"                                       ' Don't do anything if these Headers are found
        
        Case Else
            tbl.ListColumns(Col).Delete
    End Select
Next

End Sub

 

[Heretical1]

Forget about Union. Try this. See if this is what you need

Sub DelColumn()

Dim Col As Long, LastCol As Long
Dim ColToDelete As Range
Dim tbl As ListObject
Dim ws As Worksheet

Application.ScreenUpdating = False

'Define working sheet
Set ws = ActiveWorkbook.Sheets("Sheet1")

Set tbl = ws.ListObjects("Table1")

'Find Last Column with Headers. Assuming all Headers are in row 1
LastCol = ws.Range("A1").End(xlToRight).Column

'Loop and group all columns to be deleted
For Col = LastCol To 1 Step -1                           'Loop from right to left
    Select Case Cells(1, Col)
        Case "X", "Y", "Z"                                       ' Don't do anything if these Headers are found
       
        Case Else
            tbl.ListColumns(Col).Delete
    End Select
Next

End Sub

That works a treat, thankyou so much !!!!!