Solved: Insert Comment every nth word

[happypuppy]

Hi,

I'm looking for a way to insert a comment every 1000 words.
I've searched the forums for related help and what I've found is a superscript font every 5 words:

For i = 1 To Selection.Words.Count Step 5
Selection.Words(i).Font.StrikeThrough = True
Next i
As well as:

Selection.Comments.Add Range:=Selection.Range
Selection.TypeText Text:="1000 words"
I tried to put them together with:


Selection.Wholestory
For i = 1000 To Selection.Words.Count Step 1000
Selection.Comments.Add Range:=Selection.Range
Selection.TypeText Text:="1000 words"
Next i

but it just makes a comment that covers the whole document.

Any help would be much appreciated.

Also, it counts punctuation marks as words. Is there a way of avoiding these?

Many thanks!

[macropod]

Hi happypuppy,

Try:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long
With ActiveDocument
For i = 1000 To .Words.Count
If .Range(0, .Words(i).End).ComputeStatistics(wdStatisticWords) Mod 1000 = 0 Then
j = j + 1000
.Comments.Add .Words(i), "Word: " & CStr(j)
i = i + 1000
Else
i = i + 999 - .Range(0, .Words(i).End).ComputeStatistics(wdStatisticWords) Mod 1000
End If
Next
End With
Application.ScreenUpdating = True
End Sub

[happypuppy]

Oh Wow!
That is so amazing!

Thank you, Paul!

[macropod]

You're welcome. Thanks for the feedback.