VBA delete table column based on selection

[Doug Mutzig]

Hi All!

I am very new at VBA and need help with an issue I have.

I have a table on a worksheet that I will like the end user to be able to select a cell and then click a button to remove the entire table column. I have tried searching but nothing I have found relates to columns in a table. I did find a wonderful post on removing rows in a table: https://www.mrexcel.com/forum/excel-questions/683740-vba-delete-table-row-based-selection-2.html

I would love to be able to modify this to work for columns instead, but I am at a loss on where to begin, or if there is a better way.

Additionally, I have a button to add a column to a table but I also need the 2 cells above the table to also be added above the new column, is this possible?

Thank you all for any help and guidance you can provide on this!
Doug

 

[gallen]

Hi Doug and welcome.

Firstly can I assume when you say you wish to delete the table column you don't want to delete the whole column on the sheet, just the table?

To do that it would mean you are using tables via INSERT>TABLE and having a named table (list object)

This code checks the active cell, finds out which column of the table it is located in and deletes the column.

Ensure this is tested on a COPY of your data. It assumes your table is named "Table1". It needs pasting into the code module of the sheet where the table is

Sub DelCol()


    Dim tbl As ListObject
    Dim sColName As String
    
    Set tbl = Me.ListObjects("Table1")
    
    'ensure user has only selected a single cell
    If ActiveCell.Cells.Count <> 1 Then Exit Sub
    
    'check if selected cell is within the table
    If Intersect(ActiveCell, tbl.DataBodyRange) Is Nothing Then
        MsgBox "Selected cell is not within the table", vbCritical
        Exit Sub
    End If
    
    'get the column header of the table
    sColName = Cells(tbl.HeaderRowRange.Row, ActiveCell.Column)
    
    'use the column header to denote which table column to delete
    tbl.ListColumns(sColName).Delete
    
End Sub

 

[Doug Mutzig]

Hi Gallen,

Thank you so much for the code!!! It works perfectly!

I apologize for not supplying enough information, I am still trying to understand what is needed to convey an accurate and detailed question. I am using tables (created by Format Table) that are named, and you are correctly I would prefer to only delete the table column and not the entire worksheet column if possible. On some worksheet this would be ok, but on others I have data above and below the table.

Followup question:

Is it possible to also have the code delete the 2 cells above the table column as well? above my tables I have two cells that hold data used in calculating within the table column and was wondering if they could be deleted as well without deleting the entire worksheet column? If not, what would change to delete the entire worksheet column?

Thank you again for your time and patience answering my questions!
Doug

 

[Zack Barresse]

Doug,

Like the rows code, a little lengthier, but avoids some downfalls. Below is the amended code for columns versus rows.

Sub RemoveSelectedTableColumns()

    Dim Table As ListObject
    Dim Cell As Range
    Dim ColumnCount As Long
    Dim Prompt As String
    Dim MatchedColumns() As Variant
    Dim MatchTest As Variant

    Erase MatchedColumns()
    ColumnCount = 1
    For Each Cell In Selection.Cells
        If Not Cell.ListObject Is Nothing Then
            If Table Is Nothing Then
                Set Table = Cell.ListObject
            Else
                If Cell.ListObject <> Table Then
                    'different table
                    MsgBox "You have more than one table selected.", vbInformation, "ERROR!"
                    GoTo MyExit
                End If
            End If
            If ColumnCount = 1 Then
                ReDim MatchedColumns(1 To ColumnCount)
                MatchedColumns(ColumnCount) = Cell.Column - Table.HeaderRowRange.Column + 1
                ColumnCount = ColumnCount + 1
            Else
                On Error Resume Next
                MatchTest = 0
                MatchTest = WorksheetFunction.Match(Cell.Column - Table.HeaderRowRange.Column + 1, MatchedColumns(), 0)
                If MatchTest = 0 Then
                    ReDim Preserve MatchedColumns(1 To ColumnCount)
                    MatchedColumns(ColumnCount) = Cell.Column - Table.HeaderRowRange.Column + 1
                    ColumnCount = ColumnCount + 1
                End If
                Err.Clear
                On Error GoTo 0
            End If
        Else
            'a cell is not in a table
            MsgBox "Your selection is all or partially outside of a table.", vbInformation, "ERROR!"
            GoTo MyExit
        End If
    Next Cell

    Call SortArray(MatchedColumns())
    Prompt = "Are you sure you want to delete " & UBound(MatchedColumns) & " columns from '" & Table.Name & "'?"
    If MsgBox(Prompt, vbYesNo + vbDefaultButton2, "CONTINUE?") <> vbYes Then Exit Sub
    
    For ColumnCount = UBound(MatchedColumns) To LBound(MatchedColumns) Step -1
        Table.ListColumns(MatchedColumns(ColumnCount)).Delete
    Next ColumnCount

    Exit Sub

MyExit:

End Sub



Sub SortArray(MyArray() As Variant)

    Dim ArrayStart As Long
    Dim ArrayEnd As Long
    Dim Index As Long
    Dim ArrayMove As Long
    Dim ArrayTemp As Variant

    ArrayStart = LBound(MyArray)
    ArrayEnd = UBound(MyArray)
    For Index = ArrayStart To ArrayEnd - 1
        For ArrayMove = Index + 1 To ArrayEnd
            If MyArray(Index) > MyArray(ArrayMove) Then
                ArrayTemp = MyArray(ArrayMove)
                MyArray(ArrayMove) = MyArray(Index)
                MyArray(Index) = ArrayTemp
            End If
        Next ArrayMove
    Next Index

End Sub

HTH

 

[gallen]

Hi Doug.

Glad the code suits.

Regarding your follow up: Yes . Though I think you can't delete the cells, just 'clear' them:

This code should do as you ask. The only issue I see is if any info is above any columns to the right of the deleted column. It won't move with it.

Try it and let me know if I've understood ok

Sub DelCol()


    Dim tbl As ListObject
    Dim sColName As String
    Dim rDelete As Range
    
    Set tbl = Me.ListObjects("Table1")
    
    'ensure user has only selected a single cell
    If ActiveCell.Cells.Count <> 1 Then Exit Sub
    
    'check if selected cell is within the table
    If Intersect(ActiveCell, tbl.DataBodyRange) Is Nothing Then
        MsgBox "Selected cell is not within the table", vbCritical
        Exit Sub
    End If
    
    'get the column header of the table
    sColName = Cells(tbl.HeaderRowRange.Row, ActiveCell.Column)
    
    'delete from cell immedately above
    Cells(tbl.HeaderRowRange.Row, tbl.ListColumns(sColName).Range.Column).Offset(-1, 0).ClearContents
    'delete content from 2 cells above
    Cells(tbl.HeaderRowRange.Row, tbl.ListColumns(sColName).Range.Column).Offset(-2, 0).ClearContents


    'use the column header to denote which table column to delete
    tbl.ListColumns(sColName).Delete
    
End Sub

 

[Doug Mutzig]

Hi Zack,

Thank you so much for the code! I really appreciate you time and effort to modify your previous code to work.

Thank you again!
Doug

 

[Doug Mutzig]

Hi Gallen,

Thank you for the update to the code. I was wondering if Offset was the way to go, but I didn't know how to implement it. If I understand the code correctly and the logic behind it when run the cells above will be cleared and then the column deleted? This is because the column reference will change once the column is removed correct?

Thank you very much for your help on this!
Doug

 

[gallen]

Hi Gallen,
I was wondering if Offset was the way to go, but I didn't know how to implement it. If I understand the code correctly and the logic behind it when run the cells above will be cleared and then the column deleted? This is because the column reference will change once the column is removed correct?
Doug

Exactly. Once deleted the column won't exist. Easier to delete beforehand while we have the column reference. Can be done after but needless brain time and harder to read code.

The code before offset gets the cell that is on the header-row of the same column as the active cell. The offset -1 then gets the cell above it

 

[Zack Barresse]

Tables are dynamic, which is why you want to use the ListObject instead of just an ordinary Range object. You could certainly use Offset though. If you're intent on deleting the range, just make sure to encompass the columns of the Table if you want the delete to shift up (which is default). This type of deletion (above a Table range) won't work if there are additional Tables below the range which stretch out beyond the left/right borders of the deletion range.

 

[Zack Barresse]

I forgot to add, the only real assumption the code makes is that you're showing headers. If you're not the code will fail at the points referencing the HeaderRowRange since it will be Nothing at run-time. This can be accounted for if you'd like.