VBA: Array Overwriting Totals Row and Existing Data below Table

[zero269]

Hello,

Is it possible to force an Excel Table to automatically expand based on the number of rows being added from an array?

Right now when I output the array, it's overwriting the data in the Totals Row, as well as the data that resides below the table.

The following code is what I was using to test the output into an empty sheet. However, when I modified it to add the new row and then output the array to that new row in column "A", it doesn't expand the table.

Sub WIP_Filter_New_Books()

'  Declarations
   Dim arrNewBooks, Student As String: Student = "Student007"

'  Store 'New' Books into Array
   arrNewBooks = Evaluate("SORT(CHOOSECOLS(FILTER(t_Books,t_Books[" & Student & "]=""n"",""""),1,2,4,5,6,7,9,10,11,12),2)")

'  Output Array
   Sheets("Sheet1").Range("A2").Resize(UBound(arrNewBooks), UBound(arrNewBooks, 2)) = arrNewBooks

End Sub

I realize now that this is the expected behavior, considering that if I use the drag method (lower right corner) it behaves the same way.
Perhaps someone has experience with outputting array data to Tables that need to be expanded… WITH data just below the Table?

Thank you and best regards,

 

[HongRu]

You may refer to the following code.
This automatically expands the Totals Row of Table.

Sub AddRowToTable()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newRow As ListRow

    ' Set the worksheet and table name
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your worksheet name
    Set tbl = ws.ListObjects("Table1") ' Change to your table name

    ' Add a new row to the table
    Set newRow = tbl.ListRows.Add

    ' Set the data for the new row
    newRow.Range(1, 1).Value = "NewData1" ' Replace with your data
    newRow.Range(1, 2).Value = "NewData2" ' Replace with your data
    ' Continue setting data for other cells as needed
End Sub

 

[Alex Blakenburg]

I'm afraid it will take quite a bit more code than your one liner.

    ' Output Array
    Dim lo As ListObject
    Dim rngNewRow As Range
    
    Set lo = Range("Table1").ListObject         '<-- Change to your table name
    Set rngNewRow = lo.ListRows.Add.Range
    
    With lo.Range
        lo.Resize Range(.Resize(.Rows.Count - 1 + UBound(arrNewBooks, 1), .Columns.Count).Address)
    End With
    
    With rngNewRow.Resize(UBound(arrNewBooks, 1), UBound(arrNewBooks, 2))
        .Value = arrNewBooks
    End With

 

[zero269]

You may refer to the following code.
This automatically expands the Totals Row of Table.

Sub AddRowToTable()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newRow As ListRow

    ' Set the worksheet and table name
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your worksheet name
    Set tbl = ws.ListObjects("Table1") ' Change to your table name

    ' Add a new row to the table
    Set newRow = tbl.ListRows.Add

    ' Set the data for the new row
    newRow.Range(1, 1).Value = "NewData1" ' Replace with your data
    newRow.Range(1, 2).Value = "NewData2" ' Replace with your data
    ' Continue setting data for other cells as needed
End Sub

Hi HongRu,

Thanks for your recommendation. I see your macro is adding a single row and then writing data to the new row.

My current macro uses a similar method; it's adding Table Rows using a loop, and then copyig/pasting data from the source range to the destination range... in three chunks. This process is slow, and from what I've gathered online... it's much faster to resize a Table than it is to add many rows using a loop.

I'm just starting to look at arrays as a better solution. Unfortunatley, resizing the Table is a bit problematic becasue I have data that is located below the Table.

I'm thinking the best apprach would be to first add Sheet Rows below the Table and then resize the Table. I just need to figure it out.

 

[zero269]

I'm afraid it will take quite a bit more code than your one liner.

The story of my life...

I was testing your macro against my test data. Unfortunately the first resize is not pushing the data below the table downward. Example:

Before:

After:

My original appoach is adding Table Rows using a loop and then copying and pasting data from the source range to the destination range. However, I'm wondering if my approach is all wrong based on my limited knowledge with Excel VBA... and programming languages as a whole.

Perhaps this might be a better approach?

1. Add Sheet Rows below the table (to push down the exising data below the Table)
2. Resize Table to make room for the Array size; such as a 1 to 20 Array would resize table with 20 new rows.
3. Then write array to new range.

I'm currently using a NewRow variable that stores the address for the first NewRow so I can tell the macro where to paste the date. I should be able to reuse that to tell the macro where to output the array data.

Thanks Alex, I appreciate you taking a look at this for me. I'll keep grinding through this tomorrow as well.

 

[HongRu]

Try this.

Sub AddRowToTable()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newData
    ' Set the worksheet and table name
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your worksheet name
    Set tbl = ws.ListObjects("Table1") ' Change to your table name
    N_tbl_rows = tbl.ListRows.Count ' Number of Table rows
    N_tbl_cols = tbl.ListColumns.Count ' Number of Table columns
    Dim Rng_tbl As Range
    Set Rng_tbl = Cells(tbl.HeaderRowRange.Row, tbl.HeaderRowRange.Column) 'the first cell of Table
    
    newData = Range("newArray") ' Change to your new array to add the table
    N_newData = UBound(newData) ' Number of new Data
    ' 1.Add Sheet Rows below the table
    Range("A" & tbl.DataBodyRange.Row + N_tbl_rows).Resize(N_newData).EntireRow.Insert
    ' 2.Resize Table
    tbl.Resize Rng_tbl.Resize(N_tbl_rows + N_newData + 1, N_tbl_cols)
    ' 3.write array to new range
    Rng_tbl.Offset(N_tbl_rows + 1).Resize(N_newData, N_tbl_cols) = newData
End Sub

 

[Alex Blakenburg]

If I change the last line of @HongRu's code to the below, it works for me.

    Rng_tbl.Offset(N_tbl_rows + 1).Resize(N_newData, UBound(newData,2)) = newData

That code will fail if the Table has been cleared by deleting all the rows ie there is no DataBodyRange. Is that likely to ever be the case ?
Make the change below and that should cover it off.

    'Range("A" & tbl.DataBodyRange.Row + N_tbl_rows).Resize(N_newData).EntireRow.Insert
    Range("A" & tbl.Range.Row + 1 + N_tbl_rows).Resize(N_newData).EntireRow.Insert

 

[zero269]

Try this.

Sub AddRowToTable()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newData
    ' Set the worksheet and table name
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your worksheet name
    Set tbl = ws.ListObjects("Table1") ' Change to your table name
    N_tbl_rows = tbl.ListRows.Count ' Number of Table rows
    N_tbl_cols = tbl.ListColumns.Count ' Number of Table columns
    Dim Rng_tbl As Range
    Set Rng_tbl = Cells(tbl.HeaderRowRange.Row, tbl.HeaderRowRange.Column) 'the first cell of Table
   
    newData = Range("newArray") ' Change to your new array to add the table
    N_newData = UBound(newData) ' Number of new Data
    ' 1.Add Sheet Rows below the table
    Range("A" & tbl.DataBodyRange.Row + N_tbl_rows).Resize(N_newData).EntireRow.Insert
    ' 2.Resize Table
    tbl.Resize Rng_tbl.Resize(N_tbl_rows + N_newData + 1, N_tbl_cols)
    ' 3.write array to new range
    Rng_tbl.Offset(N_tbl_rows + 1).Resize(N_newData, N_tbl_cols) = newData
End Sub

Hello HongRu,

Thanks for the follow up. Your code does the trick. Specifically this line of code:

'1.Add Sheet Rows below the table
Range("A" & tbl.DataBodyRange.row + N_tbl_rows).Resize(N_newData).EntireRow.Insert

I noticed you're using EntireRow instead of ListRows.Add which is what my original code was using to expand the Tables; the slow way.
Although you mentioned it's adding Table Rows, it's actually adding Sheet Rows which explains why the data below and to the right of the Table is shifting down... starting at the Tables last row.

This is the desired results for my use case. I don't have data to the right where this code will be used. I only did it to test how it was behaving. As you can see in the 2nd image, the data to the right of the table is shifted down start where the Total Row was originally. For anyone with multiple tables horizonally may need to focus on adding Rows using ListRows.Add so not to effect data or data Tables to the Right... or Left for that matter.

Before:

After:

Becasue the above line of code does the adding and resizing using EntireRow, I didn't need this line, because the Table was being resized when the rows were being added (above code).

' 2.Resize Table
'  tbl.Resize Rng_tbl.Resize(N_tbl_rows + N_newData + 1, N_tbl_cols)

Thanks again, and best regards. This was very helpful!

 

[zero269]

If I change the last line of @HongRu's code to the below, it works for me.

    Rng_tbl.Offset(N_tbl_rows + 1).Resize(N_newData, UBound(newData,2)) = newData

That code will fail if the Table has been cleared by deleting all the rows ie there is no DataBodyRange. Is that likely to ever be the case ?
Make the change below and that should cover it off.

    'Range("A" & tbl.DataBodyRange.Row + N_tbl_rows).Resize(N_newData).EntireRow.Insert
    Range("A" & tbl.Range.Row + 1 + N_tbl_rows).Resize(N_newData).EntireRow.Insert

Hi Alex,

I tested your edit for HongRu's code. Incidently, I was getting the same results. See my two screenshots above.
At first I thought the +1 was going to insert below the Total Row, so I added some tags to the right of the Table to see what moved.
They both did the same thing to my surprise.
Either way, I'm grateful for a solution to my dilema.

Thanks again, and best regards.

 

[HongRu]

I am glad it works.
Thank for your detailed and pleasing response.

' 2.Resize Table
'  tbl.Resize Rng_tbl.Resize(N_tbl_rows + N_newData + 1, N_tbl_cols)

The code above will work better if the last row of the table is not TOTALED.
And Alex do make a very nice fix to my code.