Hello, I found a macro that allows me to select a range in a table and delete the selected rows. The point is, if the table is filtered I cant delete the rows. I have tried tweaking the code a bit to delete visible cells only to no avail. I honestly dont know what is wrong with the macro since it actually works really if not for this.
Code:
Sub DeleteTableRows()
'PURPOSE: Delete table row based on user's selection
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Call pw
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
Application.EnableEvents = False
'Set Range Variable
On Error GoTo InvalidSelection
Set rng = Selection
On Error GoTo 0
'Unprotect Worksheet
With ActiveSheet
If .ProtectContents Or ProtectDrawingObjects Or ProtectScenarios Then
On Error GoTo InvalidPassword
.Unprotect Password
ReProtect = True
On Error GoTo 0
End If
End With
'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 THE problem is here. In DeleteRng.EntireRow.Delete(if wanted)
If Answer = vbYes Then
Application.CutCopyMode = False
DeleteRng.EntireRow.Delete
Application.EnableEvents = True
End If
'Protect Worksheet
If ReProtect = True Then Sheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
Sheets("RowsDeleted").Protect Password:="1232018"
Exit Sub
'ERROR HANDLERS
InvalidCopySelection:
MsgBox "Error when deleting selection. Unfilter your table if filtered. " & vbNewLine & Err.Number & ": " & Err.Description, vbOKOnly, "Invalid deletion selection"
Application.EnableEvents = True
Exit Sub
InvalidActiveCell:
MsgBox "The first cell you select must be inside an Excel Table. " & _
"The first cell you selected was cell " & ActiveCell.Address, vbCritical, "Invalid Selection!"
If ReProtect = True Then Sheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
Application.EnableEvents = True
Exit Sub
InvalidSelection:
MsgBox "You must select a cell within an Excel table", vbCritical, "Invalid Selection!"
If ReProtect = True Then Sheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
Application.EnableEvents = True
Exit Sub
DeleteAllRows:
MsgBox "You cannot delete all the rows in the table. " & _
"You must leave at least one row existing in a table", vbCritical, "Cannot Delete!"
If ReProtect = True Then Sheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
Application.EnableEvents = True
Exit Sub
DeleteOnlyRow:
MsgBox "You cannot delete the only row in the table.", vbCritical, "Cannot Delete!"
If ReProtect = True Then Sheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
Application.EnableEvents = True
Exit Sub
InvalidPassword:
MsgBox "Failed to unlock password with the following password: " & Password
Application.EnableEvents = True
Exit Sub
End Sub
Last edited:
