Excel VBA Resize Table Copying Formulas & Shapes

Question

I have a table containing formulas and shapes on every row.

I want to resize the table based on a user's input from userform (Lets just call the value given TextBox1.Value) The user inputs a new desired table row size into the userform and clicks "OK"

Let's call the Table Table1, see code below:

Private Sub UserForm_Initialize()
    Dim ob As ListObject
    Dim count As Integer
    Set ob = Sheets("Worksheet").ListObjects("Table1")
    count = ob.Range.Rows.count - 1
    TextBox1.value = count
End Sub

Private Sub OKButton_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Dim ob As ListObject
    Dim count As Integer, i As Integer, j As Integer
    Set ob = Sheets("Worksheet").ListObjects("Table1")
    count = ob.Range.Rows.count - 1
    If TextBox1.value < 2 Then
        Unload Me
    ElseIf TextBox1.value > count Then
        ob.Resize ob.Range.Resize(TextBox1.value + 1)
        ob.ListRows(count).Range.Select
        Selection.AutoFill Destination:=ob.ListRows(count & ":" &_ 
        TextBox1.value).Range,Type:=xlFillDefault
        ob.ListRows(TextBox1).Range.Select
    ElseIf TextBox1.value < count Then
        ob.Range.Rows(TextBox1.value + 1 & ":" & count).Delete
    End If
    Application.CutCopyMode = False
    Unload Me
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

My issue is when the user inputs a value greater than the table's current row count.

The table resizes correctly, but there is an error when copying the rows.

"Run Time Error 9, Subscript out of Range"

The desire is to copy down the formulas and shapes to the newly created rows quickly.

Can anyone see what I'm doing wrong?

"...there is an error when copying the rows". What error is it? Also a note, you should [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — BruceWayne, Aug 19 '20 at 15:02
Run Time Error 9, Subscript out of Range error, If there is a way to avoid using Select, I'm all ears. It's the only way I see right now — M B, Aug 19 '20 at 15:04
Remove the `ob.ListRows(count).Range.Select` line, and replace the AutoFill line with: `ob.ListRows(count).AutoFill Destination:=ob.ListRows(...)`? — BruceWayne, Aug 19 '20 at 15:16
Removed both ```ob.ListRows(count).Range.Select``` lines, changed Autofill line to ```ob.ListRows(count).AutoFill Destination:=ob.ListRows(count & ":" & TextBox1.value)``` same error occurs? Even explicitly defining the row numbers to "10:12" still gives that error. Still playing with it to try and mitigate that error. — M B, Aug 19 '20 at 15:29

score 1 · Accepted Answer · answered Aug 19 '20 at 16:00

You can't reference multiple ListRows like ListRows(1:2) like you can with worksheet rows. That property doesn't support that argument syntax. Change that ElseIf to

ElseIf TextBox1.Value > count Then
    ob.Resize ob.Range.Resize(TextBox1.Value + 1)
    ob.ListRows(count).Range.Resize(Me.TextBox1.Value - count + 1).FillDown

and you will avoid that error.

score 0 · Answer 2 · answered Aug 19 '20 at 20:00

Here is the result working correctly for anyone who may have use for it:

Private Sub UserForm_Initialize()
    Dim ob As ListObject
    Dim count As Integer, i As Integer, j As Integer
    Set ob = Sheets("Worksheet").ListObjects("Table1")
    count = ob.Range.Rows.count - 1
    TextBox1.value = count
End Sub

Private Sub OKButton_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Dim ob As ListObject
    Dim count As Integer, i As Integer, j As Integer, k As Integer, m As Integer
    Set ob = Sheets("Worksheet").ListObjects("Table1")
    count = ob.Range.Rows.count - 1
    If TextBox1.value < 2 Then
        Unload Me
    ElseIf TextBox1.value > count Then
        ob.Resize ob.Range.Resize(TextBox1.value + 1)
        ob.ListRows(count).Range.Resize(Me.TextBox1.value - count + 1).FillDown
    ElseIf TextBox1.value < count Then
        Debug.Print "TextBox1:" & TextBox1.value & " count:" & count
        ob.Range.Rows(TextBox1.value + 2 & ":" & count + 1).Delete
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.UsedRange
    Unload Me
End Sub

Excel VBA Resize Table Copying Formulas & Shapes

2 Answers2