Anything you do that inserts the count into the document body will: (a) mess up the word count; (b) put the counter in the wrong place for each successive count; and (c) be a pain to update.
Try the following code, which inserts the counts as comments. If you edit the document and re-run the macro, the old comments it created will be deleted and a new set created.
Code:
Sub WordCountMarker()
Application.ScreenUpdating = False
Dim RngDoc As Range, RngCmt As Range, Interval As Long, i As Long
Interval = CInt(InputBox("What word frequency do you want to tag?", "Word Count Marker", 120))
With ActiveDocument
If Interval < 2 Or Interval >= .ComputeStatistics(wdStatisticWords) Then GoTo Abort
For i = .Comments.Count To 1 Step -1
If .Comments(i).Range.Text Like "Word: [0-9]*" Then
.Comments(i).Delete
End If
Next
DoEvents
Set RngDoc = .Range(0, 0)
While RngDoc.ComputeStatistics(wdStatisticWords) < .ComputeStatistics(wdStatisticWords)
With RngDoc
.MoveEnd wdWord, Interval - .ComputeStatistics(wdStatisticWords) Mod Interval
If .ComputeStatistics(wdStatisticWords) Mod Interval = 0 Then
Set RngCmt = .Characters.Last
.Comments.Add RngCmt, "Word: " & .ComputeStatistics(wdStatisticWords)
.MoveEnd wdWord, Interval
If i Mod 50 = 0 Then DoEvents
End If
End With
Wend
DoEvents
End With
Abort:
Set RngDoc = Nothing: Set RngCmt = Nothing
Application.ScreenUpdating = True
End Sub
Note: If the count interval falls within a field (e.g. Table of Contents, Index), that interval’s count is skipped, since the comment would be deleted anyway the next time the field is refreshed.
06-29-2025, 05:37 PM
Similar Threads
Macro to insert certain words if the number of words than 20
Windows 10 
Office 2016
Threaded Mode