Search code examples
vbaloopsms-worddocuments

Search all open documents, find text, and delete to the end of the document Word Macro


I am trying to write a vba word macro that searches all open documents, finds all occurrences of the text "DocumentEnd9999", and deletes everything below that text in each document.

Sub deletion()

Dim endTerm As String
endTerm = "DocumentEnd9999"

'Loop Dim
Dim n, c As Integer
n = Application.Documents.Count

For c = 1 To n
    Set myRange = Application.Documents(c).StoryRanges
    For Each myRange In ActiveDocument.StoryRanges
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = endTerm
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
        End With
        Selection.Find.Execute
        Selection.Extend
        Selection.Find.ClearFormatting
        With myRange.Find
            myRange.Characters.Last.Select
            .Forward = True
            .Wrap = wdFindAsk
        End With
        Application.DisplayAlerts = False
        Selection.Find.Execute
        Selection.Delete
    Next myRange
Next c

End Sub

Solution

  • The following code should do what you're looking for in the main body of the document. Not sure exactly why you're using StoryRanges. I'm not too familiar with that collection, so I didn't include it.

    Sub deletion()
    
        Dim endTerm As String
        endTerm = "DocumentEnd9999"
    
        Dim n, c As Integer
        n = Application.Documents.Count
        c = 1
    
        Dim r As Range
    
        Windows(c).Activate
    
        Selection.Find.ClearFormatting
            With Selection.Find
                .Text = endTerm
                .Forward = True
                .Wrap = wdFindContinue
            End With
    
        Do
    
            Selection.Find.Execute    
    
            Set r = ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Content.End)
            r.Delete
    
            c = c + 1
    
            On Error Resume Next
            Windows(c).Activate
    
        Loop Until c > n
    
    End Sub