Auto-resize Shape_width

[amrane]

dear Forum,

I am looking for your help regarding shape auto-resize based on a given cell value, for instance I am referring to a given number of stream crossing bottleneck, at the output, each stream will be treated based weight basis (refer to colored shape), so is it possible to:
Qts-1] Resize input an output shape according to the related cells value,
Qts-2] get the shape aligned every resize actions

thank you sir in advance for your support,

amrane,

[Bob Phillips]

Const startTop As Double = 70
Const startLeft As Double = 390
Const gap As Double = 5
Dim shp As Shape
Dim cell As Range
Dim heightOff As Double
Dim i As Long

    With ActiveSheet
    
        For Each cell In Range("B3", Range("B3").End(xlDown))
        
            .Shapes("Rectangle " & Right$(cell.Value, 1)).Copy
            .Paste
            Selection.Name = cell.Value
            Selection.Height = cell.Offset(0, 3).Value / 3.5
            Selection.Left = startLeft
            Selection.Top = startTop + heightOff
            heightOff = heightOff + Selection.Height + gap
        Next cell
    End With