How to avoid an error message when the filter has already been applied

[Romano_odK]

Good afternoon,
In the below code I filter in my case "warehouse 1", but when for some reason this already has been done I get an error message. Is there a way to avoid this, beside not pushing the button. So somekind of warning or message instead of an error.

Thank you for your time and have a great day.


Romano

Private Sub FilterMag1_Click()
 Range("Locatie[[#Headers],[Magazijn]]").Select
    ActiveSheet.ListObjects("Locatie").Range.AutoFilter Field:=8, Criteria1:= _
        "1"
        
        Dim r As Range, q As Range, a As Range, b As Range
Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects("Locatie")

Set q = tbl.DataBodyRange.Columns(1)
Set r = q.SpecialCells(xlCellTypeVisible)

tbl.AutoFilter.ShowAllData

r.EntireRow.Hidden = True
q.SpecialCells(xlCellTypeVisible).Rows.ClearContents
q.EntireRow.Hidden = False

tbl.Range.Sort Key1:=tbl.Range.Cells(1), Order1:=xlAscending, Header:=xlYes

'first blank row
Set a = tbl.Range.Cells(1).End(xlDown).Offset(1)
'last row
Set b = a.End(xlDown)

If Not Intersect(b, tbl.DataBodyRange) Is Nothing Then
    Range(a, b).Rows.Delete xlUp
Else 'if there's only 1 blank row
    a.Rows.Delete xlUp
End If

End Sub

 

[DanteAmor]

I understand that you want to remove everything different from "1", so try the following:

Private Sub FilterMag1_Click()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  With ActiveSheet.ListObjects("Locatie")
    .AutoFilter.ShowAllData
    .Range.AutoFilter Field:=8, Criteria1:="<>1"
    .AutoFilter.Range.Offset(1).Delete
    .AutoFilter.ShowAllData
  End With
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --