Highlight text from one open parenthesis to the next open parenthesis

175 views Asked by At

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.

1

There are 1 answers

2
macropod On BEST ANSWER

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