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:

https://drive.google.com/open?id=1z9U4eBcaOXa82h53_l_4QX38JAM8POdL

Some macro Code for MS Word:

https://drive.google.com/open?id=13Dc0FWDsxtZ_-VaWHoT67o3u6VMts2O0

Test DOC file:

https://drive.google.com/open?id=1zaBpf4hxxP9pWf6Nv2RYoRmMGGNnVzjT

awarded to jwetzell

Crowdsource coding tasks.

1 Solution

Winning solution
Tipped

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
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Style = "Heading " & h
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
    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
        .Find.Execute
    Loop
    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. https://docs.google.com/document/d/1CvqWIFUAqxj7TyTZiz895HUKeWl6-HsWgXqYlgf_25M/edit?usp=sharing
jwetzell 3 months ago
Cool thanks. That's pretty good. I just have 3 requests. See video: http://tinyurl.com/y6bktean 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 http://tinyurl.com/yyq9ut8a
tonloc 3 months ago
Ok, Thanks! Update should be at the Google Drive link again.
jwetzell 3 months ago
Thanks, can you checkout https://bountify.co/microsoft-word-custom-form
tonloc 3 months ago
Was wondering if you can modify this to count the H2 tags too. See ZIP file http://tinyurl.com/y6slkwfn
tonloc 3 months ago