VBA: Delete All Columns in a Table minus the first column

[willow1985]

I have tried a few codes online but I cannot find one that does what I am looking for.

I have a table called "PDF" on Sheet "PDF".
What I would like is a code that deletes every column in this table minus the first one so the table still exists and is ready to accept new data (therefor expanding accordingly)

The table starts on cell A36. I already have a code that clears all of the rows below A37 but it is the columns that are the problem as I need to keep the sheet columns as there is data above the table and the headers of the table can vary. It would be better if there was a way to use relative references and delete columns 2-12 for example but without deleting the table.

The below code unfortunately seems to delete the table

 'Declare Variables
    Dim oSheetName As Worksheet
    Dim sTableName As String
    Dim loTable As ListObject
 
    'Define Variable
    sTableName = "PDF"
 
    'Define WorkSheet object
    Set oSheetName = Sheets("PDF")
 
    'Define Table Object
    Set loTable = oSheetName.ListObjects(sTableName)
 
    'Loop through to delete
    For iCnt = 2 To 12
        'Delete multiple columns from the table
        loTable.ListColumns(1).Delete
    Next

Any help with this code would be greatly appreciated!!

ALSO if there was any way to delete any column that contains the word "Column" ?? Basically if the column has no data I would like it deleted from the Table.

Thank you

 

[JGordon11]

See if loTable.DataBodyRange.Delete does what you want

 

[Sequoyah]

Hi, try this code

Sub test()

Dim tbl As ListObject

Set tbl = ThisWorkbook.Sheets("PDF").ListObjects("PDF")

tbl.DataBodyRange.Offset(0, 1).Resize(tbl.DataBodyRange.Rows.Count, _
    tbl.DataBodyRange.Columns.Count - 1).Columns.Delete

End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

Sub Test()
  With Sheets("PDF").ListObjects("PDF").DataBodyRange
    Intersect(.Cells, .Offset(, 1)).ClearContents
  End With
End Sub

 

[willow1985]

Got it to work, Thank you very much everyone!!