Excel 2007: Deleting Filtered Rows using VBA

[ajay_gajree]

Private Sub Product_Exceptions()
    Call Remove_Filter
    
    'Loans
    Call Field10_Delete_Filter_Rows(Criteria1)
    'Deposits
    
    Call Remove_Filter
    
    Call Field10_Delete_Filter_Rows(Criteria2)
    Call Remove_Filter
End Sub

Private Sub Field10_Delete_Filter_Rows(Criteria As String)
     
    Worksheets(WkShM).Range("A1").AutoFilter Field:=10, Criteria1:=Criteria
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True
     
End Sub
Private Sub Remove_Filter()
    If Worksheets(WkShM).AutoFilterMode Then
    Worksheets(WkShM).Cells.AutoFilter
    End If
End Sub

Hi All

I am using the above code to Filter Data and delete the rows, so in the Sub Product_Exceptions, I first remove the Filter in the defined Worksheet WkShM if Autofilter is already on.

I then run Field10_Delete_Filter_Rows this procedure using the Defined Criteria (Criteria1)


I then repeat for a second Criteria, Criteria2.

I have around 10 Criteria I want to run through in this way.

The problem I am facing is that if the Filter for any of the Criteria comes up with no rows then this line

ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete

is deleting all my data it seems, so this technique only works if every Criteria I run through provides at least 1 filtered row.

Can anyone advise a way to stop this issue I describe above?

Thanks a lot!

 

[ajay_gajree]

Private Sub Field10_Delete_Filter_Rows(Criteria As String)

Worksheets(WkShM).Range("A1").AutoFilter Field:=10, Criteria1:=Criteria

If Application.WorksheetFunction.Subtotal(3, ActiveSheet.Columns(1)) > 1 Then
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True
Else

End If

End Sub

Found the Solution! For interest, I needed to use Application.WorksheetFunction.Subtotal(3, ActiveSheet.Columns(1)) > 1
to check if only the header row existed in the filter!

Thanks

 

[Peter_SSs]

Looks like you have a working solution but here are a couple of things to consider/try.

1. Since you appear to be using the sheet's used range for your filter, there is no need to resize it to one row less. By NOT doing that, when you offset by 1 you you introduce the row immediately below the used range. This row will always be visible (avoiding the problem of no visible rows) and is empty so can be deleted without penalty. So ..

With Worksheets(WkShM).UsedRange
  .AutoFilter Field:=10, Criteria1:=Criteria
  .Offset(1).EntireRow.Delete
  .AutoFilter
End With

2. If you were using a restricted range (ie not the used range) where the row immediately below the filter range could contain data that you don't want deleted, then you could also use a technique like this.

With Worksheets(WkShM).Range("A1:Z20")
  .AutoFilter Field:=10, Criteria1:=Criteria
  If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
    .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
  End If
  .AutoFilter
End With

Note also that using EntireRow eliminates the need to turn off/on DisplayAlerts