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