Sub SortParasBySize()
  Dim aRng As Range, aTable As Table, aRow As Row
  ActiveWindow.View = wdNormalView
  With ActiveDocument.Range.Find  'Do Find and Replace for separators
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^p"
    .Replacement.Text = "zx"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
    .Text = "zxzx"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    ActiveDocument.Range.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1
    .Text = "zx"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
  Set aTable = ActiveDocument.Tables(1)
  aTable.Columns.Add BeforeColumn:=aTable.Columns(1)
  For Each aRow In aTable.Rows
    aRow.Cells(1).Range.Text = Len(aRow.Cells(2).Range.Text)
  Next aRow
  aTable.Rows.Add BeforeRow:=aTable.Rows(1)
  aTable.SortDescending
  aTable.Columns(1).Delete
  aTable.Columns.Add    'insert empty column to reinstate extra paras between sections
  aTable.Rows(1).Delete
  aTable.ConvertToText Separator:=wdSeparateByParagraphs
End Sub