Option Explicit 
Sub Demo() 
    Dim arrTextToSort() As String 
    Dim lngIndex As Long 
    Dim oRng As Range, oRngTemp As Range 
    Dim oCol As New Collection 
    Dim oPar As Paragraph 
    Dim oDoc As Document 
    If Selection.Characters.last = vbCr Then Selection.End = Selection.End - 1 
    arrTextToSort = Split(Selection.Range.Text, vbCr) 
    QuickSortOnLength arrTextToSort, LBound(arrTextToSort), UBound(arrTextToSort) 
    Set oRng = Selection.Range 
    For lngIndex = LBound(arrTextToSort) To UBound(arrTextToSort) 
        For Each oPar In Selection.Paragraphs 
            If Left(oPar.Range.Text, Len(oPar.Range.Text) - 1) = arrTextToSort(lngIndex) Then 
                oCol.Add oPar.Range.FormattedText 
                Exit For 
            End If 
        Next 
    Next 
    Set oDoc = Documents.Add 
    Set oRngTemp = oDoc.Range 
    For lngIndex = 1 To oCol.Count 
        oCol.Item(lngIndex).Copy 
        oRngTemp.Paste 
        oRngTemp.Collapse wdCollapseEnd 
    Next 
    Set oRngTemp = oDoc.Range 
    oRngTemp.End = oRngTemp.End - 1 
    oRngTemp.Copy 
    oRng.Paste 
    oDoc.Close wdDoNotSaveChanges 
lbl_Exit: 
    Set oDoc = Nothing 
    Exit Sub 
End Sub 
Public Sub QuickSortOnLength(arrInputList() As String, lngLB As Long, lngUB As Long) 
    Dim strPivot As String, strTemp As String 
    Dim lngFirst As Long, lngLast As Long 
    lngFirst = lngLB 
    lngLast = lngUB 
    On Error GoTo lbl_Exit 
    strPivot = arrInputList(lngLB + lngUB \ 2) 
    Do While lngFirst <= lngLast 
        Do While lngFirst < lngUB And SortCompare(arrInputList(lngFirst), strPivot) 
            lngFirst = lngFirst + 1 
        Loop 
        Do While lngLast > lngLB And SortCompare(strPivot, arrInputList(lngLast)) 
            lngLast = lngLast - 1 
        Loop 
        If lngFirst <= lngLast Then 
            strTemp = arrInputList(lngFirst) 
            arrInputList(lngFirst) = arrInputList(lngLast) 
            arrInputList(lngLast) = strTemp 
            lngFirst = lngFirst + 1 
            lngLast = lngLast - 1 
        End If 
    Loop 
    If (lngLB < lngLast) Then QuickSortOnLength arrInputList, lngLB, lngLast 
    If (lngFirst < lngUB) Then QuickSortOnLength arrInputList, lngFirst, lngUB 
lbl_Exit: 
    Exit Sub 
End Sub 
Private Function SortCompare(strA As String, strB As String) As Boolean 
    Select Case True 
    Case Len(strA) < Len(strB): SortCompare = True 
    Case Len(strA) > Len(strB): SortCompare = False 
    Case Len(strA) = Len(strB): SortCompare = LCase$(strA) < LCase$(strB) 
    End Select 
End Function