Paul,

Very interesting process. With a little tweaking, it can be adapted to return a count of replacements:

Sub CountOccurencesOfReplacements()
Dim lngCount As Long, oRng As Range
  Application.ScreenUpdating = False
  Set oRng = Selection.Range
  With ActiveDocument.Range
    With .Find
      .Format = True
      .Font.Hidden = True
      If .Execute Then
        MsgBox "The document contains text formatted with the hidden font " _
             & "property. This custom procedure can't be used with the existing text."
        Exit Sub
      End If
    End With
    .Font.Hidden = True
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "dogs"
      .Replacement.Text = "men~*~* "
      .Replacement.Font.Hidden = False
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchCase = False
      .Execute Replace:=wdReplaceAll
    End With
    lngCount = .ComputeStatistics(wdStatisticWords)
    With .Find
      .Replacement.ClearFormatting
      .Text = "~*~* "
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
    End With
    .Font.Hidden = False
  End With
  oRng.Select
  Application.ScreenUpdating = True
  MsgBox "There were " & lngCount & " replacements mande.", vbInformation
End Sub