Connecting Shapes with Arrowed Lines - Debugging help! - Code attached

[Snaybot]

I want to create a macro that connects arrowed lines from the shape described in A column to the shape described in B Column

where Column A is current state and B is the Target State

So A1 to B1
A2 to B2
A3 to B3......

As of right now I have a semi-working code

[/COLOR]Option ExplicitSub Macro1()
    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets(1)
    
    Dim LastRow As Long
    LastRow = WS.Range("a" & WS.Rows.Count).End(xlUp).Row
    
    Dim Shp1 As Shape, Shp2 As Shape, Conn As Shape
    Dim i As Long
    For i = 1 To LastRow
        Set Shp1 = GetTxtBoxShapeByContent(WS.Cells(i, 1).Value, WS)
        Set Shp2 = GetTxtBoxShapeByContent(WS.Cells(i, 2).Value, WS)
        
        Set Conn = WS.Shapes.AddConnector(msoConnectorStraight, 0, 100, 0, 100)
        With Conn.ConnectorFormat
            .BeginConnect Shp1, 1
            .EndConnect Shp2, 1
            Conn.Line.EndArrowheadStyle = msoArrowheadOpen
        End With
        Conn.RerouteConnections
        Set Conn = Nothing
    Next i
End Sub


'Function that gets the wanted txtbox by its content
Function GetTxtBoxShapeByContent(iTxtBoxVal As String, WS As Worksheet) As Shape
    Dim Shp As Shape
    For Each Shp In WS.Shapes
        If Shp.TextFrame.Characters.Text = iTxtBoxVal Then
            Set GetTxtBoxShapeByContent = Shp
            Exit Function
        End If
    Next Shp

End Function[COLOR=#333333]

It keeps bugging out at

If Shp.TextFrame.Characters.Text = iTxtBoxVal Then

When ever I apply my other Macro to create the shapes from Column A and some times it bugs out randomly

[/COLOR]Sub CreateRectangles()

    Dim oDic As Object
    Dim vItem As Variant
    Dim rCell As Range
    Dim Left As Double
    Dim Top As Double
    Dim Width As Double
    Dim Height As Double
    Dim LastRow As Long
    
    Const Gap As Integer = 10 'change the gap between rectangles accordingly
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    If LastRow < 1 Then
        MsgBox "No data is available.", vbInformation
        Exit Sub
    End If
    
    Left = Range("D2").Left
    Top = Range("D2").Top
    Width = 100
    Height = 100
    
    Set oDic = CreateObject("Scripting.Dictionary")
    oDic.CompareMode = 0 '0 = case-sensitive; 1 = case-insensitive
    
    For Each rCell In Range("A1:A" & LastRow)
        oDic.Item(rCell.Value) = ""
    Next rCell
    
    For Each vItem In oDic.keys
        With ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=Left, Top:=Top, Width:=Width, Height:=Height)
            .TextFrame2.TextRange.Text = vItem
        End With
        Top = Top + Height + Gap
    Next vItem
    
    Set oDic = Nothing
    Set rCell = Nothing


End Sub
[COLOR=#333333]

 

[Domenic]

Maybe your worksheet contains a shape that does not support the TextFrame property. So you should probably test for the particular type of shape that you're interested in. For example, let's say that you're interested in AutoShapes, you could do the following...

[COLOR=green]'Function that gets the wanted txtbox by its content[/COLOR]
[COLOR=darkblue]Function[/COLOR] GetTxtBoxShapeByContent(iTxtBoxVal [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], WS [COLOR=darkblue]As[/COLOR] Worksheet) [COLOR=darkblue]As[/COLOR] Shape
    [COLOR=darkblue]Dim[/COLOR] Shp [COLOR=darkblue]As[/COLOR] Shape
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] Shp [COLOR=darkblue]In[/COLOR] WS.Shapes
        [COLOR=darkblue]If[/COLOR] Shp.Type = msoAutoShape [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]If[/COLOR] Shp.TextFrame.Characters.Text = iTxtBoxVal [COLOR=darkblue]Then[/COLOR]
                [COLOR=darkblue]Set[/COLOR] GetTxtBoxShapeByContent = Shp
                [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Function[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] Shp

[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]

Hope this helps!