madvogue29
New Member
 Joined
 Aug 28, 2020
 Messages
 22
 Office Version

 365
 Platform

 Windows
Hi I have a few tables and a few textboxes next to the tables. I want the textboxes to expand when new rows are added to the table.
The range would be dynamic hence I have to find the textbox in the specified range and then adjust the height.
I tried to code it but the height of the textbox doesnt exactly match the height of the table. can someone please help ??
Sub ResizeBox1()
Dim sTL As String
Dim sBR As String
Dim r As Range
Dim shp As Shape
Set r = Range("A120:t182") ' These values would be dynamic later (I plan to get this as an input from another function)
' Change topleft and bottomright addresses as desired
sTL = "P120" ' These values would be dynamic later
sBR = "d62" ' These values would be dynamic later
' Ensure a text box is selected
For Each shp In ActiveSheet.Shapes
If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then _
With Selection
Set r = ActiveSheet.Range(sTL)
shp.Top = r.Top
shp.Left = r.Left
Set r = ActiveSheet.Range(sBR)
shp.Width = r.Left + r.Width
shp.Height = r.Top + r.Height
End With
shp.Select Replace:=False
Set r = Nothing
End If
Next shp
End Sub
Thank you in advance
The range would be dynamic hence I have to find the textbox in the specified range and then adjust the height.
I tried to code it but the height of the textbox doesnt exactly match the height of the table. can someone please help ??
Sub ResizeBox1()
Dim sTL As String
Dim sBR As String
Dim r As Range
Dim shp As Shape
Set r = Range("A120:t182") ' These values would be dynamic later (I plan to get this as an input from another function)
' Change topleft and bottomright addresses as desired
sTL = "P120" ' These values would be dynamic later
sBR = "d62" ' These values would be dynamic later
' Ensure a text box is selected
For Each shp In ActiveSheet.Shapes
If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then _
With Selection
Set r = ActiveSheet.Range(sTL)
shp.Top = r.Top
shp.Left = r.Left
Set r = ActiveSheet.Range(sBR)
shp.Width = r.Left + r.Width
shp.Height = r.Top + r.Height
End With
shp.Select Replace:=False
Set r = Nothing
End If
Next shp
End Sub
Thank you in advance