I have a macro for Word, that should work on the entire document, but always stops early - regardless of the document or length

Question

I am trying to use a macro that will insert the text "||*||" (with * being a counter) every 100 words.

This is to break up a script, for the points I insert a different picture (it gives me stop points for editing, so I don't have to go back to far if I mess up on recording)

I asked Co-Pilot to create the script, and it did but it stopped early, so I asked it to fix it, and got a loop version instead that stopped a few 100 words earlier. When I kept trying to get it to fix it, it would just switch between the two type, but make no changes.

I have tried it on different documents, and cut the original to try different lengths, it always seems to stop after 75% (ish).

Can anyone help with getting it to run over a full document?

Sub WordCountDivide()
    Dim doc As Document
    Dim rng As Range
    Dim wordCount As Long
    Dim i As Long
    Dim counter As Long
    Dim startPos As Long
    Dim endPos As Long
    
    Set doc = ActiveDocument
    
    ' Count the number of words in the document
    wordCount = doc.ComputeStatistics(wdStatisticWords)
    
    ' Initialize the counter
    counter = 1
    
    ' Insert "|" followed by a number every 100 words
    For i = 100 To wordCount Step 100
        Set rng = doc.Words(i)
        rng.Collapse Direction:=wdCollapseEnd
        
        ' Insert the "|" and number
        rng.Text = " ||" & counter & "|| "
        
        ' Get the positions of the inserted text
        startPos = rng.Start
        endPos = rng.Start + Len(" ||" & counter & "|| ")
        
        ' Set the range for the inserted text
        Set rng = doc.Range(startPos, endPos)
        
        ' Make the inserted text red
        rng.Font.Color = wdColorRed
        
        ' Update the counter
        counter = counter + 1
    Next i

End Sub

I have searched the web, and cannot find anything to hint at the issue, and am getting no help from co-pilot.

Answer 1

Try:

Sub WordIntervalMarker()
Application.ScreenUpdating = False
Dim RngDoc As Range, Interval As Long, i As Long, j As Long
Interval = CInt(InputBox("What word intervals do you want to tag?", "Word Interval Marker", 100))
With ActiveDocument
  j = Int(.ComputeStatistics(wdStatisticWords) / Interval): Set RngDoc = .Range(0, 0)
  For i = 1 To j
    With RngDoc
      .MoveEnd wdWord, Interval
      While .ComputeStatistics(wdStatisticWords) < Interval
        .MoveEnd wdWord, Interval - .ComputeStatistics(wdStatisticWords) Mod Interval
      Wend
      If .Words.Last.End = .Sentences.Last.End - 2 Then .End = .End + 2
      If .Characters.Last.Next Like "[,:;""'’”)}]" Then .End = .End + 2
      .Collapse wdCollapseEnd: .Text = "||" & i * 100 & "|| ": .Font.Color = wdColorRed: .Collapse wdCollapseEnd
    End With
    DoEvents
  Next
End With
Set RngDoc = Nothing
Application.ScreenUpdating = True
End Sub