Resize textboxes depending on cell value

[AndyMb]

Is it possible to amend the following code to adjust the size of each textbox that's created?

Sub TextBox()

Dim Cell As Range, Row As Range
Dim sText As String
Dim iCounter As Long

For Each Row In Range("L2:L1000").Rows
    For Each Cell In Row.Cells
        If sText = "" Then
            sText = Cell
        Else
            sText = sText & " " & Cell
        End If
    Next Cell
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1000, iCounter, 192, 75).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = sText
    iCounter = iCounter + 100
    sText = ""
Next Row

End Sub

All I want to do is adjust the width of the box by a number that will be in a column.

The code currently creates a text box for each row and puts the text that's in column L into the textbox

If I had a width in say column M is it possible to adjust the column width using this number for each textbox created?

I tried to come up with a solution that would treat the textbox width as a variable so taking the first value, which in this case would be column M row 2 and making that a value of 'w'

Would it be possible to then change the textbox creation line to something like this:

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1000, iCounter, [COLOR="#FF0000"]w[/COLOR], 75).Select

where 'w' is the value of M2. the loop would then pick up the next value of M3 etc.

I came up with this but it doesn't seem to create the textboxes. Changes in red.

Sub TextBoxLine1()

Dim Cell As Range, Row As Range
Dim sText As String
Dim iCounter As Long

[COLOR="#FF0000"]Dim w As Long
Dim rCell As Range
Dim rRng As Range[/COLOR]

For Each Row In Range("A4:A1000").Rows
    For Each Cell In Row.Cells

        If sText = "" Then
            sText = Cell
        Else
            sText = sText & " " & Cell
        End If
        
        
[COLOR="#FF0000"]    Set rRng = Range("C4:C1000")
    For Each rCell In rRng.Rows
        Let w = rCell.Value
    Next rCell[/COLOR]
        

    Next Cell
  
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 811, iCounter, [COLOR="#FF0000"]w[/COLOR], 75).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = sText
    iCounter = iCounter + 75
    sText = ""
Next Row

End Sub

thanks

Andy

 

[AndyMb]

I worked it out for myself!

Those interested I changed the code to the following:

Sub TextBoxLine2()

Dim Cell As Range, Row As Range
Dim sText As String
Dim iCounter As Long
Dim i As Long
Dim iWidth As Long
i = 5

For Each Row In Range("A4:A1000").Rows
For Each Cell In Row.Cells
  iWidth = Cells(i, 2)
        If sText = "" Then
            sText = Cell
        Else
            sText = sText & " " & Cell
        End If

    Next Cell
  
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 811, iCounter, iWidth, 75).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = sText
    iCounter = iCounter + 75
    sText = ""
    i = i + 1

Next Row

End Sub

Andy