Objective: in a table, allow users to select rows (the rows where the SELECTION is), press a short cut and delete those rows. No matter if they are filtered and the selection is in non contiguous ranges or not.
I have the code below I got from another site and modified it:
The problem varies, from runtime error 1004: can't move cells in a filtered range or table to delete method of class failed (or something, it happens less often than the first one)
Sub DeleteTableRows()
'PURPOSE: Delete table row based on user's selection
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim rng As Range
Dim DeleteRng As Range
Dim cell As Range
Dim TempRng As Range
Dim Answer As Variant
Dim area As Range
Dim ReProtect As Boolean
Dim copyRange As Range
Dim pasteRange As Range
Dim wb As Workbook
Dim a As Long
'Set Range Variable
On Error GoTo InvalidSelection
Set rng = Selection
On Error GoTo 0
'Unprotect Worksheet
With ThisWorkbook.ActiveSheet
If .ProtectContents Or ProtectDrawingObjects Or ProtectScenarios Then
On Error GoTo InvalidPassword
.Unprotect Password
ReProtect = True
On Error GoTo 0
End If
End With
Set wb = ThisWorkbook
'Loop Through each Area in Selection
For Each area In rng.Areas
For Each cell In area.Cells.Columns(1)
'Is selected Cell within a table?
InsideTable = True
'Gather rows to delete
If InsideTable Then
On Error GoTo InvalidActiveCell
Set TempRng = Intersect(cell.EntireRow, ActiveCell.ListObject.DataBodyRange)
On Error GoTo 0
If DeleteRng Is Nothing Then
Set DeleteRng = TempRng
Else
Set DeleteRng = Union(TempRng, DeleteRng)
End If
End If
Next cell
Next area
'Error Handling
If DeleteRng Is Nothing Then GoTo InvalidSelection
If DeleteRng.Address = ActiveCell.ListObject.DataBodyRange.Address Then GoTo DeleteAllRows
If ActiveCell.ListObject.DataBodyRange.Rows.Count = 1 Then GoTo DeleteOnlyRow
'Ask User To confirm delete (since this cannot be undone)
DeleteRng.Select
If DeleteRng.Rows.Count = 1 And DeleteRng.Areas.Count = 1 Then
Answer = MsgBox("Are you sure you want to delete the currently selected table row? " & _
" This cannot be undone...", vbYesNo, "Delete Row?")
Else
Answer = MsgBox("Are you sure you want to delete the currently selected table rows? " & _
" This cannot be undone...", vbYesNo, "Delete Rows?")
End If
'Delete row (if wanted)
If Answer = vbYes Then
'this part is giving me troubles
For a = DeleteRng.Areas.Count To 1 Step -1
Debug.Print DeleteRng.Areas.Count
DeleteRng.Areas(a).EntireRow.Delete
Next a
End If
'Protect Worksheet
If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
End Sub