Accounting for an Empty Table - Using DataBodyRange

[Qwest336]

Hello gurus,
I've run across a problem that crops up when the filtering of a table produces no results. I am using VBA to filter the table and then copy the DataBodyRange and that works perfectly as long as there are items returned. However, when there are no results in the DataBodyRange (No visible rows), it copies the entire dataset.
I've tried a few workarounds but I can't seem to figure out the status of various properties of the DataBodyRange object so that I can account for it in code. Here's an example:
Given the following dataset:

Name Date Animal
John Doe 1/1/2017 Goldfish
Mike Smith 2/1/2017 Bear
Frank Sun 3/1/2017 Goldfish

Here's an example of the sub:

Sub test()
Dim TWB As String
TWB = ThisWorkbook.Name
Dim tbl As Object
Dim test As Variant
test = Workbooks(TWB).Sheets("Sheet1").ListObjects("Table1").DataBodyRange.Rows.Count
     With Workbooks(TWB).Sheets("Sheet1")
            Set tbl = .ListObjects("Table1")
            With tbl
                If Not .DataBodyRange Is Nothing Then
                    .DataBodyRange.Copy
                End If
            End With
        End With
End Sub

.DataBodyRange - RTE 13 - Type Mismatch
.DataBodyRange.Rows.Count = 3
.DataBodyRange.Count = 9

Therefore, since "Not .DataBodyRange Is Nothing" is evaluated as true, the range gets copied.

Now I filter the dataset for Animal = vbNullString to purposefully produce no results. The following are still the same.

.DataBodyRange - RTE 13 - Type Mismatch
.DataBodyRange.Rows.Count = 3
.DataBodyRange.Count = 9

I've read somewhere that .DataBodyRange evaluates as Null when there are zero visible rows. However, I can't get that to prove out in any of the If statements:

                If Not .DataBodyRange Is Nothing Then
                If .DataBodyRange = Null Then
                If .DataBodyRange = vbNullString Then
                If .DataBodyRange = 0 Then

The following code evaluates properly as False when there are no visible rows:

                If .DataBodyRange Is Nothing Then

However, it also evaluates improperly as False when there ARE visible rows, so it is not going to enter the If Statement and perform the copy.


I've been all over and I can't seem to find the answer to this issue. I've tried creating a function to loop through and count. I've also tried using Error Handling to skip the procedure based on the RTE. I've not been able to implement either successfully.

Any and all help is greatly appreciated!

 

[Domenic]

Try something like this...

[FONT=Courier New][COLOR=darkblue]Sub[/COLOR] test()
    [COLOR=darkblue]Dim[/COLOR] rFilter [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]With[/COLOR] ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").Range
        .AutoFilter Field:=1, Criteria1:="YourCriteria"
        [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rFilter = .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rFilter [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            .Offset(1, 0).Copy ThisWorkbook.Worksheets("Sheet2").Range("A1")
        [COLOR=darkblue]Else[/COLOR]
            MsgBox "No records found.", vbInformation [COLOR=green]'optional[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        .AutoFilter
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]

Hope this helps!

 

[Norie]

How are you filtering the table?

 

[Qwest336]

Try something like this...

[FONT=Courier New][COLOR=darkblue]Sub[/COLOR] test()
    [COLOR=darkblue]Dim[/COLOR] rFilter [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]With[/COLOR] ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").Range
        .AutoFilter Field:=1, Criteria1:="YourCriteria"
        [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rFilter = .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rFilter [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            .Offset(1, 0).Copy ThisWorkbook.Worksheets("Sheet2").Range("A1")
        [COLOR=darkblue]Else[/COLOR]
            MsgBox "No records found.", vbInformation [COLOR=green]'optional[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        .AutoFilter
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]

Hope this helps!

Thank you for the suggestion! I'll give this a try and report back.

 

[Qwest336]

How are you filtering the table?

Hello Norie...

If usrPHLAssignmentAuto.tglAnnuitantOnOff.Value = True Then
    Workbooks(TWB).Sheets("MergedData").ListObjects("DynamicOutput").Range.AutoFilter Field:=42, _
    Criteria1:=Array("4567-4567", "6547-6547"), Operator:= _
    xlFilterValues 'Occ Code
ElseIf usrPHLAssignmentAuto.tglDoThisOnOff.Value = False Then
    Workbooks(TWB).Sheets("MergedData").ListObjects("DynamicOutput").Range.AutoFilter Field:=42, _
        Criteria1:=Array("1234-1234", "9876-9876"), Operator:=xlFilterValues 
End If
    Workbooks(TWB).Sheets("MergedData").ListObjects("DynamicOutput").Range.AutoFilter Field:=4, _
        Criteria1:="Withdrawn" 
    Workbooks(TWB).Sheets("MergedData").ListObjects("DynamicOutput").Range.AutoFilter Field:=57, _
        Criteria1:="No", Operator:=xlAnd

The code above is what I use to filter the table. I then use the following sub in the same module to add it to a temporary assignment page:

Sub AddToWorksheet()
Dim TWB As String
Dim LastRow, NextRow, NewLastRow As Long
Dim Assignment, AssignedTo As String
Dim AssignedDate As Date
Dim CountVisibleRows As Variant
Dim Rng As Range
User = Application.UserName
User2 = Environ("UserName")
TWB = ThisWorkbook.Name
Assignment = WhichButton
AssignedBy = User & " - " & User2
AssignedDate = Format(Now, "mm/dd/yyyy hh:mm")

'Copy Visible Cells in Table from Merged Data to Processor Template and Log; If Range is Empty, skip the copy
    Workbooks(TWB).Activate
    
    
        'With Workbooks(TWB).Sheets("MergedData")
        '    Set tbl = .ListObjects("DynamicOutput")
        '    With tbl
        '        If Not .DataBodyRange Is Nothing Then
        
        
        
        With Workbooks(TWB).Sheets("MergedData").ListObjects("DynamicOutput").DataBodyRange '.Cells(1).CurrentRegion
           .Copy
        End With
   
 'Pastes data to Assignment Worksheet
    Workbooks(TWB).Sheets("AssignmentTemp").Activate
AssignedDate = Format(Now, "mm/dd/yyyy hh:mm")
   With Workbooks(TWB).Sheets("AssignmentTemp")
    LastRow = .Cells(.Rows.count, "A").End(xlUp).Row
    NextRow = LastRow + 1
        .Range("A" & NextRow).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
    NewLastRow = .Cells(.Rows.count, "A").End(xlUp).Row
        .Range(Cells(NextRow, 59), Cells(NewLastRow, 59)).Value = AssignedBy
        .Range(Cells(NextRow, 60), Cells(NewLastRow, 60)).Value = Assignment
        .Range(Cells(NextRow, 61), Cells(NewLastRow, 61)).Value = AssignedTo
        .Range(Cells(NextRow, 62), Cells(NewLastRow, 62)).Value = AssignedDate
    Application.CutCopyMode = False
   End With
                'End If
            'End With
       ' End With

End Sub

The the table filters are then cleared and the process is repeated for 5 additional scenarios, each time adding to the AssignmentTemp worksheet after the last row. I then delete the first two rows of the sheet (only added to maintain the table structure) and apply sorting to the table prior to assignment.

Are you thinking the way I'm filtering is having some effect?

 

[Qwest336]

I get an RTE 1004 on the Set rFilter line. As with some of the other coding, the error handling takes care of the issue and the sub reports "No records found." Is this the best way to handle it? To Trap for it?

Are you familiar with what .DataBodyRange is set to for an empty table?

Thanks for your help!

Thank you for the suggestion! I'll give this a try and report back.