CODEWITHSUNDEEP
excelvbaautofilter
Pavan Kesineni
Pavan Kesineni

Reputation: 11

Excel VBA Auto Filter and Delete filtered rows

I'm trying to copy data from on worksheet into another, filter data and delete filtered rows and keep unfiltered rows. Running into runtime error at rng.EntireRow.Delete 1004 AutoFilter method of range class failed, while trying to execute the following code. Can you please help me resolve the issue.

Code:

Public Sub listAccounts()

     Sheets("Sheet1").Cells.Copy Destination:=Sheets("listAccounts").range("A1")

     Dim ws As Worksheet, rng As Range, LstRw As Long

     Set ws = ThisWorkbook.Worksheets("listAccounts")
     
     ws.range("A1").AutoFilter Field:=4, Criteria1:=Array("1", "2", "A"), Operator:=xlFilterValues
     ws.range("A1").AutoFilter Field:=6, Criteria1:=Array("X", "Y", "Z"), Operator:=xlFilterValues

     ws.Activate

    With ws
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
        rng.EntireRow.Delete
        .AutoFilterMode = False
    End With
     
End Sub

Upvotes: 1

Views: 303

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Delete Filtered Rows (AutoFilter)

Sub ListAccounts()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Sheets("ListAccounts")
    
    wb.Sheets("Sheet1").Cells.Copy ws.Range("A1")
    
    If ws.FilterMode Then ws.ShowAllData
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' Reference the range (has headers).
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    
    ' Reference the data range (no headers).
    If rg.Rows.Count = 1 Then Exit Sub ' no data
    Dim drg As Range: Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    rg.AutoFilter 4, Array("1", "2", "A"), xlFilterValues ' note 'rg'
    rg.AutoFilter 6, Array("X", "Y", "Z"), xlFilterValues ' note 'rg'
    
    ' Attempt to reference the visible range (the filtered rows).
    Dim vrg As Range
    On Error Resume Next
        Set vrg = drg.SpecialCells(xlCellTypeVisible) ' note 'drg'
    On Error GoTo 0
    ws.AutoFilterMode = False
    
    If vrg Is Nothing Then Exit Sub ' no filtered rows
    
    vrg.Delete xlShiftUp ' no need to delete entire rows
    
    MsgBox "Accounts listed.", vbInformation
     
End Sub

Upvotes: 1

Related Questions