Just recently I\'ve been trying to delete all data rows in a table, apart from the first (which needs to just be cleared)
Some of the tables being actioned could alr
I suggest first clearcontents, then resize Table:
Sub DeleteTableRows(ByRef Table As ListObject)
Dim R As Range
On Error Resume Next
Table.DataBodyRange.ClearContents
Set R = Table.Range.Rows(1).Resize(2)
Table.Resize R
On Error GoTo 0
End Sub
I have 3 routines which work just fine, just select a cell in a table and run one of the subroutines
Sub ClearTable()
If Not ActiveCell.ListObject Is Nothing Then
ActiveCell.ListObject.DataBodyRange.Rows.ClearContents
End If
End Sub
and Shrink Table to remove the databody range except from the headers and the first data row
Sub ShrinkTable()
If Not ActiveCell.ListObject Is Nothing Then
ActiveCell.ListObject.DataBodyRange.Delete
End If
End Sub
and Delete Table to completely delete the table from the sheet
Sub DeleteTable()
If Not ActiveCell.ListObject Is Nothing Then
ActiveCell.ListObject.Delete
End If
End Sub
This VBA Sub
will delete all data rows (apart from the first, which it will just clear) -
Sub DeleteTableRows(ByRef Table as ListObject)
'** Work out the current number of rows in the table
On Error Resume Next ' If there are no rows, then counting them will cause an error
Dim Rows As Integer
Rows = Table.DataBodyRange.Rows.Count ' Cound the number of rows in the table
If Err.Number <> 0 Then ' Check to see if there has been an error
Rows = 0 ' Set rows to 0, as the table is empty
Err.Clear ' Clear the error
End If
On Error GoTo 0 ' Reset the error handling
'** Empty the table *'
With Table
If Rows > 0 Then ' Clear the first row
.DataBodyRange.Rows(1).ClearContents
End If
If Rows > 1 Then ' Delete all the other rows
.DataBodyRange.Offset(1, 0).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
End If
End With
End Sub
Would this work for you? I've tested it in Excel 2010 and it works fine. This is working with a table called "Table1" that uses columns A through G.
Sub Clear_Table()
Range("Table1").Select
Application.DisplayAlerts = False
Selection.Delete
Application.DisplayAlerts = True
Range("A1:G1").Select
Selection.ClearContents
End Sub
Your code can be narrowed down to
Sub DeleteTableRows(ByRef Table As ListObject)
On Error Resume Next
'~~> Clear Header Row `IF` it exists
Table.DataBodyRange.Rows(1).ClearContents
'~~> Delete all the other rows `IF `they exist
Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.Count - 1, _
Table.DataBodyRange.Columns.Count).Rows.Delete
On Error GoTo 0
End Sub
Edit:
On a side note, I would add proper error handling if I need to intimate the user whether the first row or the other rows were deleted or not
I wanted to keep the formulas in place, which the above code did not do.
Here's what I've been doing, note that this leaves one empty row in the table.
Sub DeleteTableRows(ByRef Table As ListObject, KeepFormulas as boolean)
On Error Resume Next
if not KeepFormulas then
Table.DataBodyRange.clearcontents
end if
Table.DataBodyRange.Rows.Delete
On Error GoTo 0
End Sub
(PS don't ask me why!)