Interchange paragraphs

[sase]

I need to sort paragraphs, with a personalized sorting criteria.

I want to select many paragraphs, and get a handle of each one, to make a sorting rule (I want to use the paragraph length)

The questions are:
1- How do I identify each paragraph in the selection?
2- How do I get the paragraph length?
3- There is a sorting function prepared to do the job? (example, in vb.net, I just need to make the sorting rule, and point it to a sorting routine)
4- How do I write the result replacing the selection?

[gmaxey]

A bit crude but this may do:


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

[sase]

A bit crude but this may do:

That's a great answer, gmaxey!