Microsoft Office Forums - View Single Post - [Solved] Count words between quotation marks

gmaxey · 01-22-2017, 08:09 AM

sojiro,

Paul knows this but since you didn't inquire about it he may have left it unsaid to keep from complicating things. However, if your documents are more that just simple text (e.g. they have endnotes, footnotes, textboxes, etc.) it is a bit more involved to get a total count and even then "total" is rather elusive ;-).

Add a footnote to your text and run Paul's code. You will see that the count of words in the footnotes are not included in either the total or quoted word count. Try with this:

Code:

Public Sub Demo()
Dim oRng As Word.Range
Dim lngValidator As Long
Dim oShp As Shape
Dim lngWordsInQoutes As Long, lngWords As Long, bSvd As Boolean
  Application.ScreenUpdating = False
  bSvd = ActiveDocument.Saved
  'Fix any skipped blank Header/Footer issue
  lngValidator = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  'Iterate through document story ranges
  For Each oRng In ActiveDocument.StoryRanges
    If oRng.StoryType < 12 Then
    'Iterate through all linked stories
    Do
      lngWords = lngWords + oRng.ComputeStatistics(wdStatisticWords)
      lngWordsInQoutes = lngWordsInQoutes + fcnCountInQuotes(oRng)
      On Error Resume Next
      Select Case oRng.StoryType
        Case 6, 7, 8, 9, 10, 11
          If oRng.ShapeRange.Count > 0 Then
            For Each oShp In oRng.ShapeRange
              If Not oShp.TextFrame.TextRange Is Nothing Then
                lngWordsInQoutes = lngWordsInQoutes + fcnCountInQuotes(oShp.TextFrame.TextRange)
              End If
            Next
          End If
        Case Else
          'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set oRng = oRng.NextStoryRange
    Loop Until oRng Is Nothing
    End If
  Next
  MsgBox "This document contains " & lngWords & " words ," & vbCr & _
      "of which " & lngWordsInQoutes & " (" & Format(lngWordsInQoutes * 100 / lngWords, "0.00") & _
      "%) are in quotes."
  ActiveDocument.Saved = bSvd
lbl_Exit:
  Exit Sub
End Sub
Function fcnCountInQuotes(ByVal oRng As Word.Range) As Long
  With oRng.Find
    .ClearFormatting
    .Text = "[“" & Chr(34) & "]*[" & Chr(34) & "”]"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    While .Execute
      fcnCountInQuotes = fcnCountInQuotes + oRng.ComputeStatistics(wdStatisticWords)
      oRng.Collapse wdCollapseEnd
    Wend
  End With
lbl_Exit:
  Exit Function
End Function

Then add a few words in a header or footer. Two words in the header of a 1 page document = 2 words. Two words in the header of a 1000 page document = 2 words.