How to end macro if no filtered results

[willow1985]

I have been trying a bunch of different ways but so far none are successful.

I am looking for a way that if there are no filtered results where I have put my note then the filter will be cleared on table named: WPG_RA, it will go to sheet called "Weekly", clear the contents of the table named "Weekly_R_A" and display msgbox: "No Results for the specified Criteria"

But I only want the code to do this if there are no filtered results, otherwise proceed as normal.

Any help would be greatly appreciated!

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Week_Data()
'
' Week_Data Macro

Application.ScreenUpdating = False
Sheets("Weekly").Select
    Rows("11:11").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
Sheets("DATA").Select
Sheets("DATA").Range("A1:Z1000000").ListObject.QueryTable.Refresh BackgroundQuery:=False
Sleep 2
DoEvents
For Each lo In ActiveSheet.ListObjects
    lo.AutoFilter.ShowAllData
      Next lo
      If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
    ActiveSheet.ListObjects("WPG_RA").Range.AutoFilter Field:=24, Criteria1:= _
       Worksheets("Weekly").Range("R2").Value
    ActiveSheet.ListObjects("WPG_RA").Range.AutoFilter Field:=18, Criteria1:= _
        Worksheets("Weekly").Range("Q2").Value
    ActiveSheet.ListObjects("WPG_RA").Range.AutoFilter Field:=25, Criteria1:= _
        Worksheets("Weekly").Range("P2").Value
        
'IF NO FILTERED RESULTS, CLEAR FILTER, GO TO SHEET "Weekly", Range("Weekly_R_A").Select Selection.ClearContents and display msgbox "No Results for the specified Criteria"
        
Range("A3").Select
    LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A3:M" & LastRowColumnA).Select
    

    
    Selection.SpecialCells(xlCellTypeVisible).Copy
    Sheets("Weekly").Select
    Range("B10").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("A10").AutoFill Destination:=Range("A10:A" & Cells(Rows.Count, "B").End(xlUp).Row), Type:=xlFillSeries
Calculate
    Range("A1").Select

    

Sheets("DATA").Select

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
  End If

Sheets("Weekly").Select

Application.ScreenUpdating = True

MsgBox "Weekly Report Complete"

End Sub

 

[Akuini]

Try:

'IF NO FILTERED RESULTS
If ActiveSheet.ListObjects("WPG_RA").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "empty"
End If

 

[willow1985]

Try:

'IF NO FILTERED RESULTS
If ActiveSheet.ListObjects("WPG_RA").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "empty"
End If

I modified it a bit but otherwise perfect. Thank you!

If ActiveSheet.ListObjects("WPG_RA").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
ActiveSheet.ShowAllData
Sheets("Weekly").Select
    Range("Weekly_R_A").Select
    Selection.ClearContents
    Range("A1").Select
            MsgBox "No Results for the specified Criteria"
            Exit Sub
End If

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.