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