Microsoft Office Forums - View Single Post - [Solved] Splitting word doc into batches of 1000 words

Guessed · 07-13-2018, 08:02 PM

This version will highlight each paragraph that contains a 1,000th word. It is more accurate on what it thinks a Word is.

Code:

Sub TagEvery1000thWordParagraph()
  Dim DocSrc As Document, lCount As Long, lDocLength As Long, aRng As Range
  Set DocSrc = ActiveDocument
  DocSrc.Range.HighlightColorIndex = wdNoHighlight
  lDocLength = DocSrc.Range.End - 2
  Set aRng = DocSrc.Paragraphs(1).Range
  Do Until aRng.End > lDocLength
    lCount = lCount + 1000
    Do Until aRng.ComputeStatistics(wdStatisticWords) > lCount Or aRng.End > lDocLength
      aRng.MoveEnd Unit:=wdParagraph, Count:=1
    Loop
    aRng.Paragraphs.Last.Range.HighlightColorIndex = wdRed
  Loop
  aRng.Paragraphs.Last.Range.HighlightColorIndex = wdNoHighlight  'remove the last para highlight
End Sub