Insert text at intervals in entire document

I am trying to 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 go back too far if I mess up on recording.

Copilot created code that stops a few 100 words short.

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

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

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