Sub RandomSortOfChap()
  Dim aPar As Paragraph
  'Add random numbers on headings
  For Each aPar In ActiveDocument.Paragraphs
    If aPar.Range.ParagraphFormat.OutlineLevel <> wdOutlineLevelBodyText Then
      aPar.Range.InsertBefore Left(Rnd(1) * 100000, 4) & vbTab
    End If
  Next aPar
  'Now sort based on the random number
  ActiveWindow.ActivePane.View.Type = wdOutlineView
  ActiveWindow.View.ShowHeading 5     'show five levels of headings
  Selection.Sort FieldNumber:="Paragraphs", SortFieldType:=wdSortFieldAlphanumeric
  ActiveWindow.ActivePane.View.Type = wdPrintView
  'And remove the numbers
  ActiveDocument.Range.Select
  WordBasic.ToolsBulletsNumbers Replace:=0, Type:=1, Remove:=1
End Sub