Using a loop to run through Adding Freeform Nodes

Hi everyone,

I'm trying to create a freeform shape based on a set of x, y coordinates in cells ranging from D3:E110, though the range will change each time so needs to be dynamic. The bit that I'm struggling with right now is the syntax for the loop - how do I add extra lines that start .AddNodes msoSegmentLine... then add each D and E cell as it increments?

This is where I'm up to so far:

Code:

---

Public Sub GetShape()
Set myDocument = Worksheets(1)
With myDocument.Shapes.BuildFreeform(msoEditingCorner, [D3], [E3])
      ' while columns in D are not empty, add the next rows to continue plotting the points for the shape
      ' how do I keep adding lines with the .AddNodes etc for each increment?
     
      Sub LoopUntilBlank()
      Dim s As Integer
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = Range("D3", Range("D3").End(xlDown)).Rows.Count
      ' Select cell d3.
      Range("D3").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For s = 1 To NumRows
        ' Append d,e columns to AddNode?
       
        ' Selects cell down 1 row from active cell.
        ActiveCell.Offset(1, 0).Select
      Next
      Application.ScreenUpdating = True
      End Sub
   
    .AddNodes msoSegmentLine, msoEditingAuto, 535.3, 437.4
    .AddNodes msoSegmentLine, msoEditingAuto, 060.3, 448.3
    .AddNodes msoSegmentLine, msoEditingAuto, 585.3, 474.6
    .AddNodes msoSegmentLine, msoEditingAuto, 110.3, 518.5
    .ConvertToShape
End With
End Sub

---

Kind regards,

Pete

Using Office365

Hi, Pete.

How do you like this code?

Code:

---

Sub GetShape()
    Dim myDocument As Worksheet
    Dim s As Integer
    Dim NumRows As Long
    Dim rng As Range
         
    Set myDocument = Worksheets(1)
    Set rng = myDocument.Range("D3").CurrentRegion
    NumRows = rng.Rows.Count
   
    With myDocument.Shapes.BuildFreeform(msoEditingCorner, [D3], [E3])
        For s = 1 To NumRows
            .AddNodes msoSegmentLine, msoEditingAuto, rng.Cells(s, 1), rng.Cells(s, 2)
        Next s
        .ConvertToShape
    End With
End Sub

---