Loop All Tables, Filter and Delete Visible Rows

[*shudder*]

Hi,

I would like to be able to loop though all tables in a workbook, apply a filter and then delete the visible cells.

I have the following code which filters all of the tables:

Sub Filter_Data()

Dim sht As Worksheet
Dim lstobj As ListObject
Dim Port_Name As String

Port_Name = ThisWorkbook.Sheets("Home").Range("A1").Value

For Each sht In ThisWorkbook.Worksheets
    For Each lstobj In sht.ListObjects
        With lstobj
            .AutoFilter.ShowAllData
            .DataBodyRange.AutoFilter Field:=1, Criteria1:="<>" & Port_Name
            .DataBodyRange.SpecialCells(xlCellTypeVisible).EntireRow.delete
            .AutoFilter.ShowAllData
        End With
    Next lstobj
Next sht

End Sub

However the delete visible cells element only works on the first table and then throws up a run-time 1004 error - Delete method of Range class failed for all of the other tables.

Many thanks in advance.

 

[John_w]

Try this:

Sub Filter_Data()

    Dim sht As Worksheet
    Dim lstobj As ListObject
    Dim Port_Name As String

    Port_Name = ThisWorkbook.Sheets("Home").Range("A1").Value
   
    For Each sht In ThisWorkbook.Worksheets
        For Each lstobj In sht.ListObjects
            With lstobj
                .AutoFilter.ShowAllData
                .DataBodyRange.AutoFilter Field:=1, Criteria1:="<>" & Port_Name
            End With
            Delete_Visible_Table_Rows lstobj
        Next lstobj
    Next sht

End Sub


Private Sub Delete_Visible_Table_Rows(table As ListObject)

    Dim visibleAreas As Range, visibleArea As Range
    Dim deleteRows As Range

    With table

        'Get visible rows
       
        Set visibleAreas = .DataBodyRange.SpecialCells(xlCellTypeVisible)
       
        'Unfilter the table to show all rows
               
        .Range.AutoFilter

        'Find all the rows that were visible
               
        Set deleteRows = Nothing
        For Each visibleArea In visibleAreas.Areas
            If deleteRows Is Nothing Then
                Set deleteRows = visibleArea
            Else
                Set deleteRows = Union(deleteRows, visibleArea)
            End If
        Next
       
        'Delete all the rows that were visible
       
        If Not deleteRows Is Nothing Then
            deleteRows.Delete
        End If
       
    End With

End Sub