spliting paragraphs after n words

robrob · #1 03-05-2020, 05:10 AM

i have a document with many paragraphs. all formated like:

T: ...
P: ...
T: ...

fist i delete all paragraphs with T: at the beginning with a macro that delete text between two words:

------------------------------------

Sub DeleteTextBetweenTwoWords()
Dim strFirstWord As String
Dim strLastWord As String
Dim objDoc As Document
Dim objWord As Object

Set objDoc = ActiveDocument
strFirstWord = "T:"
strLastWord = "P:"

With Selection
.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFirstWord & "*" & strLastWord
.Replacement.Text = strLastWord
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With

Set objDoc = Nothing
Set objWord = Nothing
End Sub
------------------------------------------

the result is that i only get the paragraphs with P: at the beginning.

how can i split now the remaining paragraphs after, for example, 50 words?

gmayor · #2 03-06-2020, 01:49 AM

What do you want to do with the two split parts of the paragraph? The following has added code to insert a paragraph break after 50 words

Code:

Sub DeleteTextBetweenTwoWords()
Dim strFirstWord As String
Dim strLastWord As String
Dim objDoc As Document
Dim lngPara As Long
Dim oRng As Range

    Set objDoc = ActiveDocument
    strFirstWord = "T:"
    strLastWord = "P:"

    With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = strFirstWord & "*" & strLastWord
            .Replacement.Text = strLastWord
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    End With

    For lngPara = objDoc.Paragraphs.Count To 1 Step -1
        Set oRng = objDoc.Paragraphs(lngPara).Range
        If oRng.Words.Count > 50 Then
            oRng.MoveStart wdWord, 50
            oRng.Collapse 1
            oRng.InsertParagraphAfter
        End If
    Next lngPara

    Set objDoc = Nothing
    Set oRng = Nothing
End Sub

robrob · #3 03-06-2020, 05:50 AM

ok.. this is not 100% what I am looking for but its definitely much better than anything I've tried. the splitting is for text analysis. so i can analyze each paragraph seperate and not the whole text together. (so VBA is not really my area of expertise) <br />
<br />
the only small change i need, my paragraph is much longer than 50 words. if i run this code, only one paragraph break is added after 50 words. i had to run it again if its for example 500 words. and for each run i get a new linebreak after every 50 words paragraph. If possible, it woult be perfect, if the linebreak is at the end of a sentence.

gmayor · #4 03-07-2020, 01:10 AM

Bearing in mind that your idea of what constitutes a 'word' and what VBA considers is a word may not coincide. The following will split the paragraphs into 50 'word' segments.

Code:

Sub DeleteTextBetweenTwoWords()

'Graham Mayor - https://www.gmayor.com - Last updated - 07 Mar 2020 

Dim strFirstWord As String
Dim strLastWord As String
Dim objDoc As Document
Dim lngPara As Long
Dim oRng As Range

    Set objDoc = ActiveDocument
    strFirstWord = "T:"
    strLastWord = "P:"

    With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = strFirstWord & "*" & strLastWord
            .Replacement.Text = strLastWord
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    End With

    For lngPara = objDoc.Paragraphs.Count To 1 Step -1
        Set oRng = objDoc.Paragraphs(lngPara).Range
        If oRng.Words.Count > 50 Then
            SplitString oRng
        End If
    Next lngPara

    With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "%%%%"
            .Replacement.Text = "^p"
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    End With
lbl_Exit:
    Set objDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Private Sub SplitString(oRng As Range)
'Graham Mayor - https://www.gmayor.com - Last updated - 07 Mar 2020 

Dim i As Integer
Dim oSplit As Range
    Set oSplit = oRng
    Do
        oSplit.MoveStart wdWord, 50
        If Len(oSplit) < 51 Then GoTo lbl_Exit
        oSplit.InsertBefore "%%%%"
    Loop
lbl_Exit:
    Set oSplit = Nothing
    Exit Sub
End Sub

robrob · #5 03-09-2020, 12:09 AM

thats perfect. Many thanks!!!!

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
Capitalize one to two words if they are the only words on a line	jrhlavac	Word VBA	1	10-08-2015 08:19 PM
How to mark underlined words in a sentence as A, B, C, D (beneath the words)	thudangky	Word	13	12-12-2013 02:22 AM
Spliting column with text and numbers	mjosic	Excel	3	04-04-2012 05:56 AM
Why Words doesn’t show the style of the selected words automatically????	Jamal NUMAN	Word	0	04-14-2011 03:20 PM