Split Text Box by Bullets with no extra return

Hi John

I used this code you kindly created; I can't find how to remove the extra 'return' it puts in each next bullet's text box?
I've experimented, but alas, no luck. Thank you :) and have a super weekend!

Code:

Code:

---

Sub SplitTextBoxes()
Dim oShp As Shape
Dim osld As Slide
Dim L As Long
Dim otr As TextRange2
Dim X As Integer
On Error GoTo err
Set oShp = ActiveWindow.Selection.ShapeRange(1)
Set osld = oShp.Parent
On Error GoTo err
If oShp.HasTextFrame Then
    If oShp.TextFrame2.HasText Then
        With oShp.TextFrame2.TextRange
            For L = 1 To .Paragraphs.Count
                Set otr = .Paragraphs(L)
              With osld.Shapes.AddTextbox(msoTextOrientationHorizontal, oShp.Left, oShp.Top + X, 400, 15)
                  .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                  .TextFrame2.VerticalAnchor = msoAnchorTop
                  .TextFrame2.MarginBottom = 0
                  .TextFrame2.MarginTop = 0
                  .TextFrame2.MarginLeft = 0
                  .TextFrame2.MarginRight = 0
                  With .TextFrame2.TextRange
                      .Text = otr.Text
                      .Font.Size = 12
                      .Font.Bold = False
                      .ParagraphFormat.Alignment = msoAlignLeft
                      .ParagraphFormat.Bullet.visible = True
                      .ParagraphFormat.Bullet.Character = 167
                      .ParagraphFormat.Bullet.Font.Name = "WingDings"
                      .ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(219, 0, 17)
                      .ParagraphFormat.LeftIndent = 14.3
                      .ParagraphFormat.FirstLineIndent = -14.3
                  End With
                  X = X + .Height
                End With
            Next L
        End With
    End If
End If
oShp.Delete
Exit Sub
err:
MsgBox "Please select a text box"
End Sub

---

Try this:

Code:

---

Sub Split_Text_Boxes()
Dim oshp As Shape
Dim osld As Slide
Dim L As Long
Dim otr As TextRange2
Dim x As Integer
Set oshp = ActiveWindow.Selection.ShapeRange(1)
Set osld = oshp.Parent
On Error GoTo err
If oshp.HasTextFrame Then
    If oshp.TextFrame2.HasText Then
        With oshp.TextFrame2.TextRange
            For L = 1 To .Paragraphs.Count
                Set otr = .Paragraphs(L)
                With osld.Shapes.AddTextbox(msoTextOrientationHorizontal, oshp.Left, oshp.Top + x, 400, 15)
                    .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                    .TextFrame2.VerticalAnchor = msoAnchorTop
                    .TextFrame2.MarginBottom = 0
                    .TextFrame2.MarginTop = 0
                    With .TextFrame2.TextRange
                        .Text = Replace(otr.Text, vbCr, "")
                        .Font.Size = 12
                        .Font.Bold = False
                        .ParagraphFormat.Alignment = msoAlignLeft
                    End With
                    x = x + .Height
                End With
            Next L
        End With
    End If
End If
oshp.Delete
Exit Sub
err:
MsgBox "Please select a text box"
End Sub

---