Search code examples
vbaexcellistobjectexcel-tables

Excel ListObject Table - Remove filtered / hidden rows from ListObject table


I am banging my head to find a way to delete filtered/hidden rows from a ListObject table.

The filtering is not performed trough the code, it's performed by the user using the table header filters. I want to remove the filtered/hidden rows before unlisting the ListObject Table and perform Subtotal operation. If I don't delete the filtered/hidden rows before unlisting the Table, these rows reappear.

Current Code :

Sub SubTotalParClassification(ReportSheetTitle)
Dim ws As Worksheet
Dim drng As Range

Endcol = ColCalculationEndIndex
Set ws = Sheets(ReportSheetTitle)

'CODE TO REMOVE HIDDEN/FILTERED ROWS
Set lo = ActiveSheet.ListObjects("Entrée")
For i = 1 To lo.ListRows.Count Step 1
    If Rows(lo.ListRows(i).Range.Row).Hidden = True Then
        lo.ListRows(i).Delete
Next

' convert the table back to a range to be able to build subtotal
ws.ListObjects("Entrée").Unlist
With ws
    'Select range to Subtotal
    Set drng = .Range(.Cells(REPORTHEADERROW, REPORTSSTARTCOL),     .Cells(EndRow, Endcol))

    'apply Excel SubTotal function
    .Cells.RemoveSubtotal
    drng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(Endcol - 6,   Endcol - 5, Endcol - 4, Endcol - 3, Endcol - 2, Endcol - 1)
     End With

'Update EndRow
EndRow = ActiveSheet.Cells(Rows.Count, REPORTSSTARTCOL).End(xlUp).Row
End Sub

Solution

  • Unfortunately, the Range.SpecialCells method does not have a specific parameter for xlCellTypeInvisible, only one for xlCellTypeVisible. To collect all of the hidden rows we need to find the compliment of the .DataBodyRange property and the visible rows, not the Intersect. A short UDF can take care of that.

    Once a Union of the hidden rows have been established you cannot simply delete the rows; you must cycle through the Range.Areas property. Each area will contain one or more contiguous rows and those can be deleted.

    Option Explicit
    
    Sub wqewret()
        SubTotalParClassification "Sheet3"
    End Sub
    
    Sub SubTotalParClassification(ReportSheetTitle)
        Dim a As Long, delrng As Range
        With Worksheets(ReportSheetTitle)
            With .ListObjects("Entrée")
                'get the compliment of databody range and visible cells
                Set delrng = complimentRange(.DataBodyRange, .DataBodyRange.SpecialCells(xlCellTypeVisible))
                Debug.Print delrng.Address(0, 0)
                'got the invisible cells, loop through the areas backwards to delete
                For a = delrng.Areas.Count To 1 Step -1
                    delrng.Areas(a).EntireRow.Delete
                Next a
            End With
        End With
    End Sub
    
    Function complimentRange(bdyrng As Range, visrng As Range)
        Dim rng As Range, invisrng As Range
    
        For Each rng In bdyrng.Columns(1).Cells
            If Intersect(visrng, rng) Is Nothing Then
                If invisrng Is Nothing Then
                    Set invisrng = rng
                Else
                    Set invisrng = Union(invisrng, rng)
                End If
            End If
        Next rng
        Set complimentRange = invisrng
    End Function
    

    Remember that it is considered 'best practise' to start at the bottom and work towards the top when deleting rows.