Excel Table Resize - Expand and Contract based on fetched data from the database- VBA Code

Question

I need some help on VBA code to resize Excel Tables. I have written a macro to populate data in an excel table within the same sheet and across the sheets. a) The data is pulled from a database
b) The database table name is a list. The user has an option to select any listed tables from the dropdown
c) Once the user clicks Validate, the table header gets populated with the column names fetched from the database
d) When the use clicks Import, the table data gets populated
e) Based on the user selection of the table name, the excel table expands to accommodate the fetched dataset.

Till here everything works well. Now the challenge is

1. If the database table size is less than what is defined in the excel table, then my excel still shows the extra columns from the previous fetch.

I tried multiple approaches to clear contents of the extra columns or deleting the table columns or recreating the table but none of the method looks good and creates flickers on the user screen.

Looking for cleaner way to reset/resize the table to both expand and contract based on the number of columns pulled from the database maintaining the original formatting and styles.

Any help on this is greatly appreciated.

Public Sub DeleteTableRows()
Dim table As ListObject
Dim SelectedCell As Range
Dim tableName As String
Dim ActiveTable As ListObject
Dim lastCol As Integer
Dim startCol As Integer ' Column index to start deleting the table after reset
Dim startRow As String ' Row name to select the start range for deleting table records
Dim objCount As Integer


 startCol = 0
 'select number of sheets want to this to run

Application.ScreenUpdating = False      'Prevent screen flickering while doing the refresh
For i = 2 To 4
If (i = 2) Or (i = 3) Then
    startCol = 7
    startRow = "A10"
ElseIf (i = 4) Then
    startCol = 7
    startRow = "A7"
End If

Sheets(i).Select

Range(startRow).Select
Set SelectedCell = ActiveCell
Selection.AutoFilter

'Determine if ActiveCell is inside a Table
On Error GoTo NoTableSelected
objCount = ActiveSheet.ListObjects.Count

tableName = SelectedCell.ListObject.Name
Set ActiveTable = ActiveSheet.ListObjects(tableName)
On Error GoTo 0

'Clear first Row
ActiveTable.DataBodyRange.Rows(1).ClearContents

'Delete all the other rows `IF `they exist
On Error Resume Next 
 
 ActiveTable.DataBodyRange.Offset(1,0).Resize (ActiveTable.DataBodyRange.Rows.Count - 1, _
 ActiveTable.DataBodyRange.Columns.Count).Rows.Delete
 Selection.AutoFilter
 On Error GoTo 0


Range(tableName & "[#Headers]").Select
' Range("Table4[#Headers]").Select
Selection.ClearContents

lastCol = ActiveSheet.ListObjects(tableName).Range.Columns.Count

'''''''''Autofit the columns'''''''''''

ActiveSheet.Columns("A:Z").AutoFit

'''''''''''''''delete Columns''''''''''
If (startCol < lastCol) And (i <> 4) Then
    Range(tableName & "[[#All],[Column" & startCol & "]:
 [Column" & lastCol & "]]").Select
    For j = startCol To lastCol
        Selection.ListObject.ListColumns(7).Delete
        Next j
    
End If

 'Execute to clear the 2nd table within the sheet as the above code is 
  handling only one table per sheet'''''
If (i = 4) Then
    Range(startRow).Select
    Set SelectedCell = Range("J7:S7")
    Selection.AutoFilter

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
    objCount = ActiveSheet.ListObjects.Count

    tableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(tableName)
    On Error GoTo 0
    Range(tableName & "[#Headers]").Select
    ' Range("Table4[#Headers]").Select
    Selection.ClearContents

    lastCol = ActiveSheet.ListObjects(tableName).Range.Columns.Count
    ActiveSheet.Columns("A:Z").AutoFit
End If
Next i

ThisWorkbook.Worksheets(2).Activate

Application.ScreenUpdating = True    

 Exit Sub
'Error Handling
NoTableSelected:
MsgBox "There is no Table currently selected!", vbCritical

End Sub

Answer 1

This is an MS fault I believe. The table expands with a data drop but does not retract. I use this code to retract the table.

Dim whateverWorksForYou etc. 

    Address1 = ActiveSheet.Cells(RowCount, 20).Address
    Address2 = "$A$1" & ":" & Address1
    ActiveSheet.ListObjects("TableName").Resize Range(Address2)