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?
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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.