MS Word VBA, replace all, infinite loop-CodePudding

I have a seemingly straightforward VBA question that I have struggled to resolve on my own. My goal is to develop a macro that will highlight text from one open parenthesis to the next open parenthesis, if there is no closed parenthesis between them. The macro works well in most cases, but creates an infinite loop in other cases that I will describe below. Here is the macro:

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 works properly when the Word file contains the following text:

text (text (text

However, the macro creates an infinite loop when the document contains only a single open parenthesis such as the following:

text (text

I would prefer for the macro to simply not highlight any text in this second case, and have struggled to figure out why the macro enters an infinite loop or how to resolve this issue.

Thank you very much for your input!

CodePudding user response：

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