vbams-wordinfinite-loopfind-replace

Highlight text from one open parenthesis to the next open parenthesis


My goal is to highlight text from one open parenthesis to the next open parenthesis, if there is no closed parenthesis between them.

Sub HighlightNestedParentheses()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    Options.DefaultHighlightColorIndex = wdGray50
    With Selection.Find
        .Text = "\([!\)]@\("
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

The macro above works when the Word file contains the following text:

text (text (text

However, there is an infinite loop when the document contains a single open parenthesis:

text (text

I prefer to not highlight any text in this second case.


Solution

  • Try:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim Rng As Range
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "\(*\)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
      End With
      Do While .Find.Execute
        With .Duplicate
          Set Rng = .Characters.Last
          Do While InStr(2, .Text, "(", vbTextCompare) > 0
            .MoveEndUntil ")", wdForward
            .End = .End + 1
            .Start = .Start + 1
            .MoveStartUntil "(", wdForward
            Set Rng = .Characters.Last
          Loop
        End With
        .End = Rng.End
        .HighlightColorIndex = wdGray50
        .Collapse wdCollapseEnd
      Loop
    End With
    Application.ScreenUpdating = True
    End Sub
    

    For your revised description:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim Rng As Range
    With ActiveDocument.Range
      Set Rng = .Duplicate
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "("
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = False
      End With
      Do While .Find.Execute
        Rng.Start = .Start + 1
        With Rng
          If InStr(.Text, ")") = 0 Then
            .HighlightColorIndex = wdBrightGreen
          Else
            .MoveEndUntil ")", wdBackward
            If InStr(.Text, "(") = 0 Then
              .MoveEndUntil "(", wdBackward
              .HighlightColorIndex = wdBrightGreen
            End If
          End If
        End With
        .Collapse wdCollapseStart
      Loop
    End With
    Application.ScreenUpdating = True
    End Sub