Thread: Deleting Filtered Results in VBA

Try this

Option Explicit

Sub deleteFiltered()
    Dim rng    As Range

    With ActiveSheet
        If Not .AutoFilterMode Then .Range("A1").AutoFilter
        .Range("a1").CurrentRegion.AutoFilter Field:=1, Criteria1:="SMITH*"

        With .AutoFilter.Range
            On Error GoTo exithandler
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                      .SpecialCells(xlCellTypeVisible)

        End With
    End With
    rng.EntireRow.Delete
exithandler:
End Sub

hi Colin,

Give this a whirl...

Option Explicit

Sub FilterAndDelete()
Dim LastRow As Long
Dim ArrOfNames As Variant
Dim i As Long
'to speed up the macro
With Application
    .ScreenUpdating = False
'with large sheets, calculations at each change of filter can become
'painfully slow
    .Calculation = xlCalculationManual
End With

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'define list of names
ArrOfNames = Array("SMITH*", "JONES*")
'Loop through names to filter
For i = LBound(ArrOfNames) To UBound(ArrOfNames)
    Columns("G:G").AutoFilter Field:=1, Criteria1:=ArrOfNames(i)
'in case no visible cells are found
On Error Resume Next
        Rows("2:" & LastRow).SpecialCells(xlVisible).Delete Shift:=xlUp
On Error GoTo 0
'remove filter
Columns("G:G").AutoFilter Field:=1
    Next i

'to return settings
With Application
    .ScreenUpdating = True
    'NB: this assumes your file was originally set on auto-calcuation
    .Calculation = xlCalculationAutomatic
End With
End Sub

hth
Rob

LOL :-)

Roy's is tidier than mine but doesn't do the looping - can you merge all the principles yourself? ;-)
Give it a go & let us see how it looks...

I think you will need to change "Field:=1" to be "Field:=7" in Roy's version.

hth
Rob

Hi Colin,

No need for a loop.

In a separate area on another sheet preferably, add the column G label name, list the names you want to filter underneath this and name this range say "Name_Crit". In this example I'm assuming the column G label header is in G1 and called 'Names'

Now run the following macro

Sub FilterNames()
    Range(Range("G1"), Range("G" & Application.Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Name_Crit"), Unique:=False
    Range(Range("G2"), Range("G" & Application.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.ShowAllData
End Sub

Don't forget that if you run this when you are not on the sheet containing the names, you'll need to modify the macro to include a reference to the sheet name.

HTH

To add one more approach to the mix which you can use and avoid having to loop for different names, change sheet etc -- ie process (& delete where appl.) all rows for all names simultaneously:

Public Sub PurgeNames()
With Range(Cells(2,"G"),Cells(Rows.Count,"G").End(xlUp)).Offset(,Columns.Count-7)
    .FormulaR1C1 = "=IF(OR(LEFT(RC7,5)=""SMITH"",LEFT(RC7,5)=""JONES""),""x"",1)"
    .SpecialCells(xlCellTypeFormulas,xlTextValues).EntireRow.Delete
    .Clear
End With
End Sub

You can adapt the formula to test for as many different names simultaneously as you want and delete all rows in one go.

(I've assumed you were deleting the Entire Row - if not the above can be adjusted to delete just cells in G)