Microsoft-Word Macro to count words
New here? Learn about Bountify and follow @bountify to get notified of new bounties! x

I need two Microsoft Word macros:

  • One macro to count the words in the content of an H1 tag, and place the word_count in the text.
  • One macro to remove these words

Here's a video to describe the job:

Some macro Code for MS Word:

Test DOC file:

awarded to jwetzell

Crowdsource coding tasks.

1 Solution

Winning solution

I believe this should work (it is mainly taken from the example you provided) the main addition is in the with RngHd section. It still displays the message box with the summary and then the titles get replaced after clicking ok

Sub wordCount()
    Application.ScreenUpdating = False
    Dim RngHd As Range, h As Long, strOut As String, wordCount As String
    h = 1
    With ActiveDocument.Range
    With .Find
        .Text = ""
        .Style = "Heading " & h
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Do While .Find.Found
        Set RngHd = .Paragraphs(1).Range
        Set RngHd = RngHd.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")

        With RngHd
        wordCount = .ComputeStatistics(wdStatisticWords) - .Paragraphs.First.Range.ComputeStatistics(wdStatisticWords)
        .Paragraphs.First.Range.Text = wordCount & " ~ " & .Paragraphs.First.Range.Text
        strOut = strOut & Count & vbTab & .Paragraphs.First.Range.Text
        End With
        .Start = RngHd.End
    End With
    Set RngHd = Nothing
    MsgBox "The following word counts are associated with each level " & h & " heading:" & vbCr & strOut
    Application.ScreenUpdating = True
End Sub
That works pretty good. But I need it to work just like in the video. e.g. using two Macros: h1Addwordcount() and h1Delwordcount() So, one Macro to create the numbers, and one macro to remove the numbers.
tonloc 3 months ago
Ok, here are the updated scripts, I found some errors with the originally submitted one that didn't quite copy the 'Heading 1' style right when replacing the text. So now they both should work.
jwetzell 3 months ago
Cool thanks. That's pretty good. I just have 3 requests. See video: I'll give you a Bountify tip too.
tonloc 3 months ago
Ok, I've updated the solution at the Google Drive link above with those three things.
jwetzell 3 months ago
Thanks. I sent a tip. I have 2 more requests
tonloc 3 months ago
Ok, Thanks! Update should be at the Google Drive link again.
jwetzell 3 months ago
Thanks, can you checkout
tonloc 3 months ago
Was wondering if you can modify this to count the H2 tags too. See ZIP file
tonloc 3 months ago