you could do that with a System.Collections.SortedList and a Scripting.Dictionary:
Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Static lngRun As Long
Dim lngIndex As Long
Dim oSL As Object, oDic As Object
Dim oPar As Paragraph
ReEntry:
Set oSL = CreateObject("System.Collections.SortedList")
Set oDic = CreateObject("Scripting.Dictionary")
For Each oPar In ActiveDocument.Paragraphs
If Not oSL.Contains(Len(oPar.Range.Text)) Then
oSL.Add Len(oPar.Range.Text), oPar.Range
Else
oDic.Add oPar.Range, Len(oPar.Range.Text)
End If
Next
On Error GoTo Reset
For lngIndex = 1 To lngRun
oSL.RemoveAt oSL.Count - 1
Next lngIndex
lngRun = lngRun + 1
oSL.GetByIndex(oSL.Count - 1).Select
On Error GoTo 0
For lngIndex = 0 To oDic.Count - 1
Debug.Print oDic.Keys()(lngIndex) & " " & oSL.Getkey(oSL.Count - 1)
If oDic.Items()(lngIndex) = oSL.Getkey(oSL.Count - 1) Then
MsgBox "Other paragraphs were found with the same length."
Exit For
End If
Next lngIndex
lbl_Exit:
Set oSL = Nothing: Set oDic = Nothing
Exit Sub
Reset:
lngRun = 0
If MsgBox("You have reached to the shortest paragraph. Do yo want to exit", vbYesNo, "LOOP") = vbYes Then
Resume lbl_Exit
Else
Resume ReEntry
End If
End Sub