Delete visible filtered Rows, Run-time error 1004:Cannot use that command on overlapping selections-CodePudding

I need to delete visible filtered Rows.
I got this Run-time error 1004: Cannot use that command on overlapping selections.
My data has header on first row.
In advance , greatfull for your help.

Sub Macro2()
 
    Dim rng As Range: Set rng = ActiveSheet.Range("A1:Q6880")
    rng.AutoFilter Field:=8, Criteria1:="0"
    rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
End Sub

CodePudding user response：

Delete Filtered Rows

Option Explicit

Sub Macro2()
 
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    Dim rng As Range: Set rng = ws.Range("A1:Q6880")
    ' If your range is contiguous (no empty rows or columns):
    'Dim rng As Range: Set rng = ws.Range("A1").CurrentRegion
    
    Dim fcrg As Range: Set fcrg = rng.Columns(8) ' Filter Column Range
    ' Filter Column Data Range (no headers)
    Dim fcdrg As Range: Set fcdrg = fcrg.Resize(fcrg.Rows.Count - 1).Offset(1)
    
    frg.AutoFilter Field:=1, Criteria1:="0"
    
    Dim vfcdrg As Range ' Visible Filter Column Data Range
    On Error Resume Next
        Set vfcdrg = fcdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    ws.AutoFilterMode = False
    If vfcdrg Is Nothing Then Exit Sub ' no filtered values
    
    vfcdrg.EntireRow.Delete
 
End Sub

CodePudding user response：

In some circumstances, filtering creates a discontinuous range with overlapping areas. Please, try the next way, which eliminates these overlappings:

Sub MacroDeleteFilteredRows()
    Dim rng As Range: Set rng = ActiveSheet.Range("A1:Q6880")
    rng.AutoFilter field:=8, Criteria1:="0"
    Intersect(ActiveSheet.cells, rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow).Delete
End Sub

A error handling for the case of no any visible cells in the filtered range is good to be implemented, even if this situation is not very probable...