Adding a loop without Excel crashing

[dcoker]

Can anyone help with adding a loop here so that no text boxes overlap? I have tried to add a loop but Excel stops responding and I have to force close Excel.

Sub MoveOverlappingTextBoxes()
    Dim ws As Worksheet
    Dim tb As Shape
    Dim i As Integer
    Dim j As Integer
    Dim tb2 As Shape

    Set ws = ActiveSheet

    For i = 1 To ws.Shapes.Count
        Set tb = ws.Shapes(i)
        If tb.Type = msoTextBox Then
            For j = i + 1 To ws.Shapes.Count
                Set tb2 = ws.Shapes(j)
                If tb2.Type = msoTextBox Then
                    If tb2.Type = msoTextBox And tb.Name <> tb2.Name Then
                    If Not (tb.Top > tb2.Top + tb2.Height Or _
                    tb.Left > tb2.Left + tb2.width Or _
                    tb.Top + tb.Height < tb2.Top Or _
                    tb.Left + tb.width < tb2.Left) Then
                        tb.Top = tb.Top + tb2.Height + 5
                        tb.Left = tb.Left + tb2.width + 5
                        tb2.Top = tb2.Top - tb.Height - 5
                        tb2.Left = tb2.Left - tb.width - 5
                    End If
                    End If
                End If
            Next j
        End If
    Next i
 
    
End Sub