Help with VBA code - wont Exit Sub if filtered table returns no results

[willow1985]

I have tried the below 2 variations of code but I cannot seem to get the macro to Exit Sub when the filtered table returns no results.

Please advise what I am doing wrong?

Code Variation 1

With Sheets("Chromium on Steels").ListObjects("Chromium_on_Steels_T2")
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
        End With

    Sheets("Action Item Log").Select
    ActiveSheet.ListObjects(1).AutoFilter.ShowAllData
    ActiveSheet.ListObjects("Action_Item_Log").Range.AutoFilter Field:=1, Criteria1 _
        :="Chromium on Steels"
If ActiveSheet.ListObjects("Action_Item_Log").Range.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then
Sheets("Chromium on Steels").Select
    MsgBox "No Records Found"
    Exit Sub
Else

    Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Chromium on Steels").Select
    Range("Chromium_on_Steels_T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
End If

End Sub

Code Variation 2:

With Sheets("Chromium on Steels").ListObjects("Chromium_on_Steels_T2")

If Not .DataBodyRange Is Nothing Then

.DataBodyRange.Delete

End If

End With



Sheets("Action Item Log").Select

ActiveSheet.ListObjects(1).AutoFilter.ShowAllData

ActiveSheet.ListObjects("Action_Item_Log").Range.AutoFilter Field:=1, Criteria1 _

:="Chromium on Steels"

If ActiveSheet.ListObjects("Action_Item_Log").Range.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then

Sheets("Chromium on Steels").Select

MsgBox "No Records Found"

GoTo Quit:

Else



Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select

Selection.Copy

Sheets("Chromium on Steels").Select

Range("Chromium_on_Steels_T2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("A2").Select

End If

Quit:

End Sub

 

[willow1985]

Are you trying to copy all visible cells from the Action_Item_Log table to the other table?

Yes. Action_Item_Log table is the master table. I cloned your code 7 times. 7 different Macros for 7 different sheets that I wanted updated from the Action Item Log however only 2 out of the 7 are working and the rest are giving me that error and I cannot figure out why. They are all identical and the only things that differ are the names of the tables, the names of the sheets and what is being filtered

 

[Fluff]

Ok, try replacing

.Parent.Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy

with

.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy

 

[willow1985]

Ok, try replacing

.Parent.Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy

with

.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy

Now they are all working! Thank you so much!!

What was causing the error? (If you don't mind me asking)

 

[Fluff]

Without being able to see your workbook, I'm not entirely sure.

 

[willow1985]

Well thank you for all of your help!

 

[Fluff]

You're welcome & thanks for the feedback.