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

 

[Fluff]

How about

   With Sheets("Action Item Log").ListObjects("Action_Item_Log")
      .AutoFilter.ShowAllData
      .Range.AutoFilter Field:=1, Criteria1:="Chromium on Steels"
      If .ListColumns(1).Range.SpecialCells(xlCellTypeVisible).count = 1 Then
         MsgBox "No Records Found"
         Exit Sub
      End If
   End With
End Sub

 

[willow1985]

How about

   With Sheets("Action Item Log").ListObjects("Action_Item_Log")
      .AutoFilter.ShowAllData
      .Range.AutoFilter Field:=1, Criteria1:="Chromium on Steels"
      If .ListColumns(1).Range.SpecialCells(xlCellTypeVisible).count = 1 Then
         MsgBox "No Records Found"
         Exit Sub
      End If
   End With
End Sub

How would I incorporate your code into my below code? If there are results I want it to select the specified range:

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

With Sheets("Chromium on Steels").ListObjects("Chromium_Plating_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"
    Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Chromium on Steels").Select
    Range("Chromium_Plating_on_Steels_T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select

 

[Fluff]

Like

Sub willow()
   With Sheets("Action Item Log").ListObjects("Action_Item_Log")
      .AutoFilter.ShowAllData
      .Range.AutoFilter Field:=1, Criteria1:="Chromium on Steels"
      If .ListColumns(1).Range.SpecialCells(xlCellTypeVisible).count = 1 Then
         MsgBox "No Records Found"
         Exit Sub
      End If
      .Parent.Range("B3:G" & Cells(Rows.count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
   End With
   Range("Chromium_on_Steels_T2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
   Range("A2").Select
End Sub

 

[willow1985]

Like

Sub willow()
   With Sheets("Action Item Log").ListObjects("Action_Item_Log")
      .AutoFilter.ShowAllData
      .Range.AutoFilter Field:=1, Criteria1:="Chromium on Steels"
      If .ListColumns(1).Range.SpecialCells(xlCellTypeVisible).count = 1 Then
         MsgBox "No Records Found"
         Exit Sub
      End If
      .Parent.Range("B3:G" & Cells(Rows.count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
   End With
   Range("Chromium_on_Steels_T2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
   Range("A2").Select
End Sub

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

Is there a reason why? I used this to clear Table: Chromium_on_Steels_T2 of all old data first. Does your code incorporate this somehow?

 

[Fluff]

You would need to put that at the start of the macro.

 

[willow1985]

You would need to put that at the start of the macro.

Now that I think of it, I would only want it cleared if there are filtered results....

I modified the code as follows and it appears to work. Thank you very much! ? ?

        With Sheets("Action Item Log").ListObjects("Action_Item_Log")
      .AutoFilter.ShowAllData
      .Range.AutoFilter Field:=1, Criteria1:="Chromium on Steels"
      If .ListColumns(1).Range.SpecialCells(xlCellTypeVisible).Count = 1 Then
      Sheets("Action Item Log").ListObjects("Action_Item_Log").AutoFilter.ShowAllData
         MsgBox "No Records Found"
         Exit Sub
      End If
      With Sheets("Chromium on Steels").ListObjects("Chromium_on_Steels_T2")
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
        End With
      .Parent.Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
   End With
   Range("Chromium_on_Steels_T2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False
      Sheets("Action Item Log").ListObjects("Action_Item_Log").AutoFilter.ShowAllData
   Range("A2").Select
End Sub

 

[Fluff]

You're welcome & thanks for the feedback.

 

[willow1985]

You're welcome & thanks for the feedback.

Sorry to bother you again, but I tried to apply the same code to another sheet however I am getting an error #1004 No cells were found on the .parent line. Is there something I am missing?

I thought I would only have to replace the Table and Sheet Names

                With Sheets("Action Item Log").ListObjects("Action_Item_Log")
      .AutoFilter.ShowAllData
      .Range.AutoFilter Field:=1, Criteria1:="Copper Plating"
      If .ListColumns(1).Range.SpecialCells(xlCellTypeVisible).Count = 1 Then
      Sheets("Action Item Log").ListObjects("Action_Item_Log").AutoFilter.ShowAllData
         MsgBox "No Records Found for Copper Plating Steels on Action Item Log"
         Exit Sub
      End If
      With Sheets("Copper Plating").ListObjects("Copper_Plating_T2")
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
        End With
      .Parent.Range("B3:G" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
   End With
   Range("Copper_Plating_T2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False
      Sheets("Action Item Log").ListObjects("Action_Item_Log").AutoFilter.ShowAllData
   Range("A2").Select

End Sub

 

[Fluff]

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