Expand/Collapse Table using VBA

[XL_NOOB_89]

VBA INLINE AT BOTTOM
Issue: I have a chart connected to a table (Table1). Sometimes, not every line in Column1 of this table has data in it, and this is driving the table. These blank lines in Column1 are currently displayed in the legend of the chart as blank lines. Column2 of the table are values (formulas) associated with the info in Column1. So column1 is text, and Column2 are numbers.

Solution to the problem: I need the VBA to expand/collapse the table, so there are no blanks. Also sort the values from largest to smallest in Column2 of the table.

Scope: This VBA attached WORKS PROPERLY, except for one issue. The UsedRows command is counting the blank cells as used cells. I can force this VBA to work 100% by doing the following:

1. Put a breakpoint on the line where UsedRows = Application.CountA(myColumn.DataBodyRange)
2. Press play to run the VBA
3. When the VBA hits the break point, highlight the blank lines in Column1 of the table and press “Delete” on my keyboard
4. Press the play button and continue to run the VBA and it will work as I need it

Notes for Code: Table1 is defined as range AI9:AJ13. There is a formula in cells AH9:AH13, which only displays text if multiple criteria are met. If the criteria are not met, then the formula returns a “” value

Any help here would be appreciated. VBA below

Sub Test()
'Clear Table contents
Worksheets("Test Document").ListObjects("Table1").ListColumns(1).DataBodyRange.Clear


Dim myColumn As ListColumn
Set myColumn = Sheets("Test Document").ListObjects("Table1").ListColumns("Column1")

For Each rng In Range("AI9:AI13")
rng.Value = rng.Offset(0, -1)
Next rng


'Find used rows
Dim UsedRows As Long
UsedRows = Application.CountA(myColumn.DataBodyRange)


'Find total rows
Dim oSheetName As Worksheet
Dim sTableName As String
Dim loTable As ListObject
Dim loRows As Integer
Dim iRows As Integer

sTableName = "Table1"
Set oSheetName = Sheets("Test Document")
Set loTable = oSheetName.ListObjects(sTableName)

'Resize table to only used rows
loTable.Resize loTable.Range.Resize(UsedRows + 1)

MsgBox "Done"

End Sub

 

[BSALV]

For Each Rng In Range("AI9:AI13")
          If Rng.Offset(0, -1).Value <> "" Then Rng.Value = Rng.Offset(0, -1)
     Next Rng

 

[XL_NOOB_89]

worked beautifully - I really liked the simplicity of it. Thank you BSALV

 

[BSALV]

you're welcome