Sub CapitalizeHeading()
Dim arrExcludedWords() As String
Dim colExclude As New Collection
Dim lngCount As Long, lngPar As Long, lngIndex As Long
Dim oRng As Range
Dim oPar As Paragraph
Dim bTC As Boolean
  Application.ScreenUpdating = False
  'List of word to be excluded from capitalization
  arrExcludedWords = Split("a, above, across, against, along, among, an, and, around, as, at, because, before, behind, below, beneath, beside, between, beyond, but, by, down, during, for, from, in, into, nor, of, off, on, onto, or, over, per, since, so, the, through, to, toward, under, unless, with, within, without, yet", ", ")
  'Add words to collection.  Makes it more efficient to check if each word is excluded.
  For lngIndex = 0 To UBound(arrExcludedWords)
    colExclude.Add arrExcludedWords(lngIndex), arrExcludedWords(lngIndex)
  Next lngIndex
  'Store user's track changes status
  bTC = ActiveDocument.TrackRevisions
  'Turn on tracked changes
  ActiveDocument.TrackRevisions = True
  lngCount = ActiveDocument.Paragraphs.Count
  For lngPar = 1 To lngCount
    Set oPar = ActiveDocument.Paragraphs(lngPar)
    oPar.Range.MoveEnd unit:=wdCharacter, Count:=-1 ' Exclude the paragraph mark
    Application.StatusBar = "Processing paragraph " & lngPar & " of " & lngCount
    Select Case oPar.Style
      Case "Heading 1", "Heading 2", "Heading 3", "Report Title", "Report Subtitle", "Figure/Table Title"
        For lngIndex = 1 To oPar.Range.Words.Count
          Set oRng = oPar.Range.Words(lngIndex)
          If lngIndex = 1 Then
            If oRng.Characters(1).Text Like "[a-z]" Then
              oRng.Characters(1).Text = UCase(oRng.Characters(1).Text)
            End If
          Else
            If oRng.Words.Last.Next = "-" Then
              oRng.MoveEnd wdWord, 1
              lngIndex = lngIndex + 1
            End If
            On Error Resume Next
            colExclude.Add Trim(oRng.Text), Trim(oRng.Text)
            If Err.Number = 0 Then
              colExclude.Remove (colExclude.Count)
              If oRng.Characters(1).Text Like "[a-z]" Then
                oRng.Characters(1) = UCase(oRng.Characters(1))
              End If
            Else
              Err.Clear
              'Skip it is an excluded word.
            End If
          End If
        Next
    End Select
  Next lngPar
  ActiveDocument.TrackRevisions = bTC
  Application.StatusBar = False
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub