Splitting word doc into batches of 1000 words

PakNotaris · #16 07-13-2018, 06:56 PM

Hi Paul,
That is exactly what I mean: could the macro work in such as way so as to split the doc into 1,000-word chunks separating these by a page break?

Thank you so much again. And my apologies for not having made this clear from the outset.

Guessed · #17 07-13-2018, 07:16 PM

If you want to simply tag a single document with every 100th word then I would just use Highlighting to make it obvious where these are. A macro method to add the highlights should probably firstly remove any existing highlights but that might not be what you want.

Code:

Sub TagEvery1000thWord()
  Dim lWord As Long
  ActiveDocument.Range.HighlightColorIndex = wdNoHighlight
  For lWord = 1000 To ActiveDocument.Words.Count Step 1000
    ActiveDocument.Words(lWord).HighlightColorIndex = wdPink
  Next lWord
End Sub

PakNotaris · #18 07-13-2018, 07:25 PM

Great, thank you! It works

But why would it split the doc into approximately 850-word sections not 1,000? Odd, isn't it?

Thank you again. I do appreciate your help with this

Guessed · #19 07-13-2018, 07:44 PM

ActiveDocument.words has a twisted idea on what a Word is. It includes paragraph marks for instance.

We would need to go back to ComputeStatistics to resolve that. I'll have another look at the code

PakNotaris · #20 07-13-2018, 07:46 PM

Aha! Thank you, Andrew. Have a lovely weekend.
Best wishes,
Alex

Guessed · #21 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

macropod · #22 07-13-2018, 08:02 PM

And, for my part:

Code:

Sub Segmenter()
Application.ScreenUpdating = False
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
  Set Rng = .Range(0, 0): j = 1000
  For i = 1 To -Int(-.ComputeStatistics(wdStatisticWords) / j)
    If .Range(Rng.Start, .Range.End).ComputeStatistics(wdStatisticWords) < j Then Exit For
    With Rng
      .MoveEnd wdWord, j
      .End = .Paragraphs.Last.Range.End
      If .End = DocSrc.Range.End Then Exit For
      .InsertAfter vbCr
      .Collapse wdCollapseEnd
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

PakNotaris · #23 07-13-2018, 09:07 PM

Thank you both so much. Both macros work really well. You have been of great help

Best wishes,

Alex

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to find (highlight) two and more words in a list of 75k single words in Word 2010	Usora	Word	8	05-29-2018 03:34 AM
Problem with words splitting into 2 lines	sharkrfish	Word	2	05-21-2015 04:47 PM
Redirect mail in batches in Office for MAC 2011	mervalong	Outlook	0	11-08-2011 12:17 AM
Help Splitting and images in word 2007.	aligahk06	Drawing and Graphics	1	10-08-2009 12:58 AM
WORD 2003 Need help splitting a HUGE Document	dlawson	Word	4	04-14-2009 12:22 PM