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 already have no rows, so I was running it to problems as using .DataBodyRange.Rows.Count
on a table with no rows (just header and/or footer) causes errors.
I looked all over for a solution an could not find a whole one, so I hope my answer to this question will be useful to others in the future.
This question is related to
excel
vba
excel-2007
The codes above wouldn't work in Excel 2010 My code bellow allows you to go through number of sheets you would like then select tables and delete rows
Sub DeleteTableRows()
Dim table As ListObject
Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject
'select ammount of sheets want to this to run
For i = 1 To 3
Sheets(i).Select
Range("A1").Select
Set SelectedCell = ActiveCell
Selection.AutoFilter
'Determine if ActiveCell is inside a Table
On Error GoTo NoTableSelected
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
Next i
Exit Sub
'Error Handling
NoTableSelected:
MsgBox "There is no Table currently selected!", vbCritical
End Sub
I'm simply using this:
On Error Resume Next
Worksheets("Sheet1").ListObjects("Table1").DataBodyRange.Rows.Delete
The first line stays in all cases (it is cleared, of course).
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 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!)
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 is how I clear the data:
Sub Macro3()
With Sheet1.ListObjects("Table1")
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.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
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
Source: Stackoverflow.com