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!!!!

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

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