How to delete Text between start and end vba word

Question

How can one go about deleting text between a start word and an end word.

I have a huge text extract of about 1 million plus words and I want create a VBA Script which will delete all the unwanted text.

Fortunately I have the key words to look for and delete all the text after those key words up to a specific end point which I would like to enter.

I need a program that can find these key words and dedicate them as the start words and then an end word as the end position and to delete all the text in between them. If the word is situated within a paragraph, I would like to delete the paragraph.

Program below does all of what I am looking for, except it is not able to loop through the document and do it to other messages with the same start and end position.

Sub SelectRangeBetween()


Selection.HomeKey Unit:=wdStory
'Selection.TypeText Text:="hello"

 ' The Real script
Dim myrange As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
    .Execute findtext:="From: [email protected]", Forward:=True, Wrap:=wdFindStop 'this will initiate the start word
    Set myrange = Selection.Range
    myrange.End = ActiveDocument.Range.End
    myrange.Start = myrange.Start
    myrange.End = myrange.End + InStr(myrange, "This message has been scanned ") ' this will initiate the end word
    myrange.Select

    'Selection.Delete
End With
End Sub

What you need to do is use the Macro Recorder to setup your Find Statements and then use a Loop to go through the entire document — Jean-Pierre Oosthuizen
Hi there, I have created the program that selects the portion i need, but there are more of these portions in the document. I need a loop to loop through the word document and highlight every account. please refer to my program below — jaydub
Script looking better, but you need to set it as a Edit to your question and not an answer. — Jean-Pierre Oosthuizen
I was asking how does one do that, But I clicked and understand now...should add it to the initital question. — jaydub
just under your question there is a "edit" hyperlink click it and then paste your script in there — Jean-Pierre Oosthuizen

Jean-Pierre Oosthuizen Jean-Pierre Oosthuizen · Accepted Answer · 2015-12-01T14:40:18

The Script below will search for your your two keys words and select the range from the Start of the first key word to the end of the second key word. Just remove the ' to delete the range.

Sub SomeSub()

Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, FindEndRange As Range
Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range

'Setting up the Ranges
Set Find1stRange = ActiveDocument.Range
Set FindEndRange = ActiveDocument.Range
Set DelRange = ActiveDocument.Range

'Set your Start and End Find words here to cleanup the script
StartWord = "From: [email protected]"
EndWord = "This message has been scanned "

'Starting the Find First Word
With Find1stRange.Find
    .Text = StartWord
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    'Execute the Find
    Do While .Execute
        'If Found then do extra script
        If .Found = True Then
            'Setting the Found range to the DelStartRange
            Set DelStartRange = Find1stRange
            'Having these Selections during testing is benificial to test your script
            DelStartRange.Select

            'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
            FindEndRange.Start = DelStartRange.End
            FindEndRange.End = ActiveDocument.Content.End

            'Having these Selections during testing is benificial to test your script
            FindEndRange.Select


            'Setting the Find to look for the End Word
            With FindEndRange.Find
                .Text = EndWord
                .Execute

                'If Found then do extra script
                If .Found = True Then
                    'Setting the Found range to the DelEndRange
                    Set DelEndRange = FindEndRange

                    'Having these Selections during testing is benificial to test your script
                    DelEndRange.Select

                End If

            End With

            'Selecting the delete range
            DelRange.Start = DelStartRange.Start
            DelRange.End = DelEndRange.End
            'Having these Selections during testing is benificial to test your script
            DelRange.Select

            'Remove comment to actually delete
            'DelRange.Delete



        End If      'Ending the If Find1stRange .Found = True
    Loop        'Ending the Do While .Execute Loop
End With    'Ending the Find1stRange.Find With Statement

End Sub

To Select the Paragraph that key word is in then see below:

Sub SomeOtherSub()

Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, ParagraphRange As Range

'Setting up the Ranges
Set Find1stRange = ActiveDocument.Range
Set ParagraphRange = ActiveDocument.Range


'Set your Start and End Find words here to cleanup the script
StartWord = "From: [email protected]"
EndWord = "This message has been scanned "

'Starting the Find First Word
With Find1stRange.Find
    .Text = StartWord
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    'Execute the Find
    Do While .Execute
        'If Found then do extra script
        If .Found = True Then

            'Having these Selections during testing is benificial to test your script
            'Find1stRange.Select

            'Setting the Paragraph range
            Set ParagraphRange = Find1stRange.Paragraphs(1).Range

            'Having these Selections during testing is benificial to test your script
            ParagraphRange.Select

            'Deleting the paragraph
            'FoundParagraph.Delete

        End If      'Ending the If Find1stRange .Found = True
    Loop        'Ending the Do While .Execute Loop
End With    'Ending the Find1stRange.Find With Statement

End Sub

How to delete Text between start and end vba word

1 Answers