Clear a Table

[gheyman]

I have code in one workbook that clears a table. It works great. performs the code in seconds. I tried to copy the code to another workbook to perform the same process but in the new workbook it takes almost 10 minutes to run. Not sure what's the difference and why it would take so long in the second workbook. (even if I put the same number of rows in both tables)

The first code is where it works in seconds

Sub Clear_ItemID()

'Clear table - remove all rows except the first row
    Application.ScreenUpdating = False

    ActiveSheet.ListObjects("ItemIDTable").HeaderRowRange.Select
    'Remove the filters if one exists.
    If ActiveSheet.FilterMode Then
    Selection.AutoFilter
    End If
    'Clear all lines but the first one in the table leaving formulas for the next go round.
    With Worksheets("ItemIdList").ListObjects("ItemIDTable")
    .Range.AutoFilter
    On Error Resume Next
    .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
    .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
    ActiveWindow.SmallScroll Down:=-10000

    End With
    
    Application.ScreenUpdating = True

    Sheet1.Range("A21").Activate

End Sub

code that takes forever to run

Sub ClearTable()
'Clear table - remove all rows except the first row
    Application.ScreenUpdating = False

    ActiveSheet.ListObjects("TableSQDSearch").HeaderRowRange.Select
    
    'Remove the filters if one exists.
    
    If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
    
    
    
    'Clear all lines but the first one in the table leaving formulas for the next go round.
    With Worksheets("Search").ListObjects("TableSQDSearch")
    .Range.AutoFilter
    On Error Resume Next
    .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
    .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
    ActiveWindow.SmallScroll Down:=-10000

    End With
    
  '  Sheet2.ShowAllData
    
    Application.ScreenUpdating = True

    Range("B26").Activate
End Sub

Thanks

 

[My Aswer Is This]

If you want to clear all the value in the Table why not used something like this:

Sub Clear_Table_Range()
'Modified 12/15/2020  3:29:59 PM  EST
Application.ScreenUpdating = False
ActiveSheet.ListObjects("Table5").DataBodyRange.ClearContents
End Sub

 

[My Aswer Is This]

Now if you actually wanted to delete all the rows in the Table except for the fist row.
Try this:

Sub Clear_Table_Range()
'Modified 12/15/2020  3:43:59 PM  EST
Application.ScreenUpdating = False
Dim ans As Long
ans = ActiveSheet.ListObjects("Table5").DataBodyRange.Rows.Count
ActiveSheet.ListObjects("Table5").DataBodyRange.Rows(1).Resize(ans - 1).Delete
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Now if you actually wanted to delete all the rows in the Table except for the fist row.
Try this:

Sub Clear_Table_Range()
'Modified 12/15/2020  3:43:59 PM  EST
Application.ScreenUpdating = False
Dim ans As Long
ans = ActiveSheet.ListObjects("Table5").DataBodyRange.Rows.Count
ActiveSheet.ListObjects("Table5").DataBodyRange.Rows(1).Resize(ans - 1).Delete
Application.ScreenUpdating = True
End Sub

I always like it when posters say thanks that worked. I don't like this new feature where all poster does is click on solution button.