Count Occurrences of Selected Text
(A Microsoft Word Help & Tip page by Gregory K. Maxey)

Sub TextCountQuick()
'Counts current word or selected word/string.
Dim rngStory As Range
Dim strPhrase As String
Dim i As Long
Dim oShp As Word.Shape
  System.Cursor = wdCursorWait
  'If there is no selection, select current word.
  With Selection
    If .Type <> wdSelectionNormal Then Selection.Words(1).Select
    'Unselect any empty space, line breaks and paragraph marks after text.
    .MoveEndWhile cset:=" ", Count:=wdBackward
    .MoveEndWhile cset:=Chr(13), Count:=wdBackward
    .MoveEndWhile cset:=Chr(11), Count:=wdBackward
     strPhrase = .Text
  End With
  'Reset F/R parameters
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Wrap = wdFindStop
  End With
  'Find and count.
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      With rngStory.Find
        .Text = strPhrase
        Do While .Execute
          i = i + 1
        Loop
      End With
      Select Case rngStory.StoryType
        Case 6, 7, 8, 9, 10, 11
          On Error GoTo Err_Handler
          If rngStory.ShapeRange.Count > 0 Then
            For Each oShp In rngStory.ShapeRange
              If oShp.TextFrame.HasText Then
                With oShp.TextFrame.TextRange.Find
                  .Text = strPhrase
                  Do While .Execute
                    i = i + 1
                  Loop
                End With
              End If
            Next
          End If

        Case Else
          'Do Nothing
      End Select
Err_ReEntry:
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
  If strPhrase = Chr(13) Then strPhrase = "The paragraph mark"
  If strPhrase = Chr(11) Then strPhrase = "The linebreak"
  If strPhrase = Chr(9) Then strPhrase = "The tab character"
  Select Case i
    Case 1
      MsgBox """" & strPhrase & """ occurs " & i & " time in the document.", , "Text Count"
    Case Is > 1
       MsgBox """" & strPhrase & """ occurs " & i & " times in the document", , "Text Count"
  End Select
  System.Cursor = wdCursorNormal
Exit Sub
Err_Handler:
Resume Err_ReEntry:
End Sub