CODEWITHSUNDEEP
excelvba
AdamDynamic
AdamDynamic

Reputation: 791

Excel VBA - Check whether a filtered table returns any results

I have a macro that filters a table (in the code as a ListObject) and then copies the visible cells in the DataBodyRange to a seperate table. The code works fine unless the filtering action removes all the data (i.e. the table only has the header row and nothing else).

Is there a neat way to check whether any rows are visible? I'd like to avoid on error resume terms if possible, I'm struggling to think of any other way though?

I've included some pseudocode below to illustrate what I mean, any assistance would be much appreciated!

Adam

If TargetTable.DataBodyRange.VisibleRows.Count > 0 Then
    TargetTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=OutputPasteRange
End If

Upvotes: 7

Views: 20629

Answers (3)

Slai
Slai

Reputation: 22866

Just check if the Range.Height is not 0:

If [Table1].Height Then

Also, .SpecialCells(xlCellTypeVisible) is not needed when the .Height is more than 0:

If TargetTable.DataBodyRange.Height Then TargetTable.DataBodyRange.Copy OutputPasteRange

Upvotes: 5

LazerEyes01
LazerEyes01

Reputation: 21

An alternate approach would be to compare .SpecialCells(xlCellTypeVisible).Address to the header row address, tbl.HeaderRowRange.Address.

Here is a variation of David's code:

Sub TestEmptyTable()
    Dim tbl As ListObject
    Dim outputPasteRange As Range
    Dim tblIsVisible As Boolean

    Set tbl = ActiveSheet.ListObjects(1)
    Set outputPasteRange = Range("B15")

    tblIsVisible = tbl.Range.SpecialCells(xlCellTypeVisible).Address <> _ 
        tbl.HeaderRowRange.Address

    If tblIsVisible Then
        tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=outputPasteRange
    Else
        MsgBox tbl.Name & " has been filtered to no visible records", vbInformation
    End If
End Sub

Upvotes: 2

David Zemens
David Zemens

Reputation: 53623

Use the Table's Range object, not the DataBodyRange. Then, check to make sure that .SpecialCells(xlCellTypeVisible).Rows.Count > 1.

Sub TestEmptyTable()
Dim tbl As ListObject
Dim outputPasteRange As Range
Dim tblIsVisible As Boolean

Set tbl = ActiveSheet.ListObjects(1)
Set outputPasteRange = Range("B15")

If tbl.Range.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then
    tblIsVisible = True
Else:
    tblIsVisible = tbl.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1
End If

If tblIsVisible Then
    tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=outputPasteRange

Else:
    MsgBox tbl.Name & " has been filtered to no visible records", vbInformation

End If

End Sub

Upvotes: 6

Related Questions