Split a text box into two text boxes on the same slide

[StarPig]

These might be useful:

The first splits a text box by the existing bullets (or paragraph return) - so each bullet has its own text box with a pre-set width in the code (currently 500).

The second one merges selected text boxes into one text box, but all become the first bullet level (currently WingDings 108).

TO SPLIT

Sub Split()
    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
    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, 500, 0)
                        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                        .TextFrame2.VerticalAnchor = msoAnchorTop
                        .TextFrame2.MarginBottom = 0
                        .TextFrame2.MarginTop = 0
                        With .TextFrame2.TextRange
                            .Text = Replace(otr.Text, vbCr, "")
                            .Font.Bold = False
                            .ParagraphFormat.Alignment = msoAlignLeft
                            .ParagraphFormat.Bullet.Visible = True
                            .ParagraphFormat.Bullet.Character = 108
                            .ParagraphFormat.Bullet.Font.Name = "WingDings"
                            .ParagraphFormat.Bullet.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                            .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
End Sub

TO MERGE

Sub Merge()
    Dim oRng As ShapeRange
    Dim oFirstShape As Shape
    Dim oSh As Shape
    Dim x As Long
    Set oRng = ActiveWindow.Selection.ShapeRange
    Set oFirstShape = oRng(1)
    oFirstShape.TextFrame.TextRange.Text = _
    oFirstShape.TextFrame.TextRange.Text & vbCrLf
    For x = 2 To oRng.Count
        oFirstShape.TextFrame.TextRange.Text = _
        oFirstShape.TextFrame.TextRange.Text _
        & oRng(x).TextFrame.TextRange.Text
        If x < oRng.Count Then
            oFirstShape.TextFrame.TextRange.Text = _
            oFirstShape.TextFrame.TextRange.Text _
            & vbCrLf
        End If
    Next
    For x = oRng.Count To 2 Step -1
        oRng(x).Delete
    Next
    Set oRng = Nothing
    Set oFirstShape = Nothing
    Set oSh = Nothing
    Exit Sub
End Sub