[VBA]: Delete empty rows from multiple tables and then print the range to pdf

[IIII]

Hi All,

I have this worksheet (see below) that has multiple formatted tables. Users are able to add or remove table rows as needed.

What I'm wishing for it to do via VBA is the following:

1. Remove any empty rows from any of the tables
2. Print the whole thing from A2 down to F...the row just after the last table row -- which in the example below is F50). Columns A & F are empty - both are used to create a blank border for print to pdf.

I haven't been able to work this one out or even know where to look.

If additional clarity is needed, please let me know. Thanks for any help or guidance in advance. Cheers!

Example of Shathousery.xlsx
	A	B	C	D	E	F
2
3				Lorem ipsum dolor sit amet, consectetur adipiscing elit.
4				Total Cost for Thing:	$ -
5
6		Thing	Dates	Details	Cost
7		Car (Staff)	Fri, 21 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
8				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
9		Car (Staff)	Mon, 24 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.
10				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
11		Fuel		Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 400.00
12				Sub-total cost for Transport	$ 400.00
13
14		Thing	Dates	Details	Cost
15		Hotel	Fri, 21 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
16				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
17		Hotel	Mon, 24 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
18					$ -
19				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 824.00
20				Sub-total cost for Accomodation	$ 824.00
21
22		Thing	Dates	Details	Cost
23		Lesson	Fri, 21 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
24				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
25				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 172.00
26		Tour	Sat, 22 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.
27				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
28				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 480.00
29				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
30		Ride	Sun, 23 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
31				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 350.00
32				Sub-total cost for Activities	$ 1,002.00
33
34		Thing	Dates	Details	Cost
35		Day 1	Fri, 21 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 100.00
36		Day 2	Sat, 22 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 100.00
37		Day 3	Sun, 23 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 100.00
38		Day 4	Mon, 24 Apr 23	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 60.00
39				Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ 50.00
40
41
42
43
44
45
46				Sub-total cost for Meals	$ 410.00
47
48		Thing	Dates	Details	Cost
49		Staff Name	TBA	Lorem ipsum dolor sit amet, consectetur adipiscing elit.	$ -
50
Plan

 

[OaklandJim]

I'll try to assist. Are there always the same number of tables? What are the tables' names? Are empty rows those without a date?

 

[OaklandJim]

I'll take the liberty of naming the first four tables based on the expense category: Transportation, Accommodations, Activities and Meals.

 

[OaklandJim]

Code below seems to do what you want. Note that I found out the hard way that you cannot name a table if the name is already in use in another worksheet. So, if you have more than one expense report worksheet you cannot use the same names for the tables. If you do copy a sheet with named tables Excel will add digits to the end of the table names.

That said, my code should still work as I added code to trim those digits off.

Option Explicit

Function TrimDigitsFromString(psString As String) As String

    Dim iLen As Long
    
    Dim iCharNum As Long
    
    iLen = Len(psString)

    TrimDigitsFromString = "?"
    
    For iCharNum = 1 To iLen

        If Right(psString, 1) Like "#" _
         Then
            
            psString = Left(psString, Len(psString) - 1)

        Else
            TrimDigitsFromString = psString
            
            Exit Function

        End If
        
    Next iCharNum
    
End Function

Option Explicit

Sub DeleteEmptyTableRows()

    Dim wsExpenses As Worksheet

    Dim tDataTable As ListObject

    Dim iTableRow As Long

    Dim iKeyColumn As Long

    Dim avDataArray() As Variant
    
    Dim sName As String

'   Worksheet where tables are located.
    Set wsExpenses = Worksheets("Plan") '<= change this if the Expenses worksheet name changes

'   Key column used to determine if a row is empty. 2 is Date.
    iKeyColumn = 2 '<= change this if the column used to determine if the row is "empty" changes

    For Each tDataTable In wsExpenses.ListObjects

        With tDataTable

            sName = TrimDigitsFromString(.Name)
            
'           Only process specific tables in the Expenses worksheet.
            If sName = "Transportation" Or _
               sName = "Accommodations" Or _
               sName = "Activities" Or _
               sName = "Meals" _
             Then

'               Put table contents into an array.
                avDataArray = .DataBodyRange

'               Loop "backwards" through each item in Date Column of Table
                For iTableRow = UBound(avDataArray) To LBound(avDataArray) Step -1

                    If avDataArray(iTableRow, iKeyColumn) = "" _
                     Then
                        .ListRows(iTableRow).Delete
                    End If

                Next iTableRow

            End If

        End With

    Next tDataTable

End Sub