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 — BruceWayne
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
Remove the ob.ListRows(count).Range.Select line, and replace the AutoFill line with: ob.ListRows(count).AutoFill Destination:=ob.ListRows(...)? — BruceWayne
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

Dick Kusleika Dick Kusleika · Accepted Answer · 2020-08-19T16:00:56

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.

Excel VBA Resize Table Copying Formulas & Shapes

2 Answers