Select a range of text for a find & replace macro to apply to

Question

I have a Word macro that does hundreds of find and replace operations, but currently it applies the operations to the entire document. I need it to only apply to text between "Abstract" (bold, match case) and "References" (bold, match case).

The current code applies changes to the whole document, and then at the end of the macro, it retrospectively rejects any changes to the References with the following code:

With Selection.Find
 .ClearFormatting
 .Font.Bold = True
 .MatchCase = True
 .Forward = True
 .Execute FindText:="References"
  
    If .Found = True Then
         
        Selection.Find.Execute
        Selection.Collapse wdCollapseStart

        Dim r1 As Range
        Set r1 = Selection.Range
        
        Selection.Find.Text = "DummyText"
   
        Selection.WholeStory
        Selection.Collapse wdCollapseEnd
  
        Dim r2 As Range
        Set r2 = ActiveDocument.Range(r1.start, Selection.start)
        r2.Select
    
        If Selection.Range.Revisions.Count >= 1 Then _
        Selection.Range.Revisions.RejectAll
        
    End If

End With

This selects the text between "References" in bold and "DummyText", which is just some text that's guaranteed not to be found so it selects to the end of the document, and then rejects any changes within that selection.

I've tried adapting this and putting it at the start of the macro so that all the find and replace operations only apply to the selection between the Abstract and the References like this:

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Abstract"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Font.Bold = True
        .MatchCase = True
        .MatchWholeWord = True
    End With
    Selection.Find.Execute
    Selection.Collapse wdCollapseStart

    Dim r1 As Range
    Set r1 = Selection.Range

    Selection.Find.Text = "References"
    Dim r2 As Range
    Set r2 = ActiveDocument.Range(r1.start, Selection.start)
    r2.Select

    ' Move cursor to start, turn on tracked changes
    
    Selection.HomeKey Unit:=wdStory
    ActiveDocument.TrackRevisions = True
    With ActiveWindow.View.RevisionsFilter
        .markup = wdRevisionsMarkupSimple
        .View = wdRevisionsViewFinal
    End With
    
    ' start replacements (these go on for ages, two examples here)
        
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Also "
        .Replacement.Text = "Additionally, "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
        .Text = "Therefore "
        .Replacement.Text = "Therefore, "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' and so on...

Other threads I've read seem to suggest

.Wrap = wdFindStop

in the replace fields would do what I want, but that doesn't work.

Can anybody help? Cheers.

user_4705583 · Answer

You need to use multiple ranges. Once you have established the range to search then if you find something, the first thing you must do is make sure what you found is within the range. The example code below does that.

Sub FindInRange()
    Dim rng As Word.Range, rStart As Long, rEnd As Long
    Dim iRng As Word.Range
    
    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Format = True
        .Forward = True
        .Font.Bold = True
        .MatchCase = True
        .MatchWholeWord = True
        .Text = "Abstract"
        .Wrap = wdFindStop
        .Execute
        If .found = True Then
            rStart = rng.End
            rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            .Text = "References"
            .Execute
            If .found Then
                rEnd = rng.Start
            End If
        End If
    End With
    
    If rStart > 0 And rEnd > 0 Then
        Set iRng = rng
        iRng.Start = rStart
        iRng.End = rEnd
    Else
        Exit Sub
    End If
    
    Set rng = iRng
    With rng.Find
        .ClearFormatting
        .Format = True
        .Forward = True
        .Font.Bold = True
        .MatchCase = True
        .MatchWholeWord = True
        .Text = "Something"
        .Wrap = wdFindStop
        .Execute
        If .found = True And rng.InRange(iRng) Then
            'do something
        End If
    End With
    
End Sub

user_9170274 · Answer

For example:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Abstract"
    .Font.Bold = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    Set Rng = .Duplicate
    With .Duplicate
      .End = ActiveDocument.Range.End
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "References"
        .Font.Bold = True
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Execute
      End With
      If .Find.Found = True Then
        Rng.End = .Duplicate.End
        Rng.Revisions.RejectAll
      End If
    End With
  Loop
End With
Application.ScreenUpdating = True
End Sub

The above code accommodates multiple 'Abstract' and 'References' blocks, if needed.

Select a range of text for a find & replace macro to apply to

2 Answers