Problem highlighting specific words within the selected range in Word document through VBA Macros-CodePudding

I am trying to select a range between two words and then trying to find a word within the found range and finally color that word. In the image I want to select range between "Observation" and "Supporting Information" and then search for "Management" words and color them to red. But with my code I am able to highlight only first occurrence of the word. Can someone please help me here.

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range

On Error Resume Next

Application.DisplayAlerts = False
Application.ScreenUpdating = False


    Set rng1 = ActiveDocument.Range
        If rng1.Find.Execute(FindText:="Observation:") Then
            Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
            If rng2.Find.Execute(FindText:="Supporting Information:") Then
                Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
                If rngFound.Find.Execute(FindText:="Management") Then
                    rngFound.Select
                    Selection.Range.HighlightColorIndex = wdRed
                End If
            End If
        End If
    Selection.HomeKey wdStory

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

CodePudding user response：

The Find method in word can be a bit tricky to manage. What you want to achieve must be done with two searches inside a loop. The first search finds the next 'Observation:', the Second Finds the following 'Supporting Information:'. You then use the end of the first search and the start of the second search to generate the range that needs to be made 'wdRed'

The following code works well on my PC

Option Explicit

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

    Dim myOuterRange As Word.Range
    Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
    With myOuterRange
        
        Do
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "(Observation)([: ]{1,})(^13)"
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                
            End With
                
            Dim mystart As Long
            mystart = .End
            
            .Collapse direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
            
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "^13Supporting Information"
                .Wrap = wdFindStop
                
                
                If Not .Execute Then Exit Do
                
            End With
            
            Dim myEnd As Long
            myEnd = .Start
            
            ActiveDocument.Range(mystart, myEnd).Font.ColorIndex = wdRed
            
            .Collapse direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
        Loop
        
    End With
    
        
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub

UPDATE This is the code I first wrote. I blame a biscuit (cookie) shortage for misreading the post the second time and revising my code to the first provided.

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

    Dim myOuterRange As Word.Range
    Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
    With myOuterRange
        
        Do
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "(Observation:)(*)(Supporting Information:)"
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                
            End With
            
            Dim myInnerRange As Word.Range
            Set myInnerRange = .Duplicate
            
            With myInnerRange
                
                With .Find
                
                    .Text = "Management"
                    .Replacement.Font.ColorIndex = wdRed
                    .Wrap = wdFindStop
                    .Execute Replace:=wdReplaceAll
                    
                    
                End With
                
            End With
            
            .Collapse Direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
        Loop
        
    End With
    
        
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub

CodePudding user response：

A modified version of your code using Find to highlight the text.

Sub RevisedFindIt4()
    ' Purpose: highlight the text between (but not including)
    ' the words "Observation:" and "Supporting Information:" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFound As Range
    Dim highlightIndex As Long
    

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'capture current highlight color so that it can be reset later
    highlightIndex = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdRed

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Observation:") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="Supporting Information:") Then
            Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
            With rngFound.Find
                .Replacement.highlight = True
                .Execute Replace:=wdReplaceAll, Forward:=True, FindText:="Management", ReplaceWith:="", Format:=True
            End With
        End If
    End If

    Options.DefaultHighlightColorIndex = highlightIndex
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub