Word VBA macro on parentheticals - vba

Question

I have been using the following macro to pull out items in parenthesis to comments in word:
'
' CommentBubble Macro
'
'
Dim myRange As Range
Set myRange = ActiveDocument.Content
searchtext = "\(*\)"
With myRange.Find
.MatchWildcards = True
Do While .Execute(findText:=searchtext, Forward:=True) = True
If Len(myRange.Text) > 4 Then
ActiveDocument.Comments.Add myRange, myRange.Text
myRange.Text = ""
End If
Loop
End With
End Sub
The reason I have the length of the text be > 4 is because these are legal documents and I don't want to isolate strings that have things like "in the following conditions: (i) condition 1, (ii) condition 2, etc."
However, here is a snippet of text for which the above code breaks:
This is sample text (with some additional text) that does stuff (with more stuff) and represents 39.4% of shares on the effective date (before giving effect, with some conditions such as ( some stuff (i) and some stuff (ii) with final stuff) and more final stuff) which is subject to (some conditions here) and conclude here.
If you run this you will get the following result:
This is sample text that does stuff and represents 39.4% of shares on the effective date and some stuff (ii) with final stuff) and more final stuff) which is subject to and conclude here.
As you can see the nested parenthesis cause some trouble. Any advice?
Thanks!

Answer 1

You are trying to match parentheses which in Word is a difficult and thankless task as Word only sees opening and closing parentheses as individual characters and not automatically matched by word. The code below finds matching parentheses, eliminates trailing spaces, habdles the case of no parentheses being present, and errors out if you have unbalanced errors. I've left in debugging statements so that you can uncomment them to see what is happening.
Option Explicit
Public Sub ttest()
Dim myRange As Word.Range
Set myRange = ActiveDocument.StoryRanges(wdMainTextStory)
myRange.Collapse direction:=wdCollapseStart
Set myRange = NextParenRange(myRange)
Do Until myRange Is Nothing
DoEvents
Debug.Print myRange.Text
Dim myDupRange As Word.Range
Set myDupRange = myRange.Duplicate
myRange.Collapse direction:=wdCollapseEnd
If myDupRange.Characters.Last.Next.Text = " " Then myDupRange.MoveEnd Count:=1
myDupRange.Delete
Set myRange = NextParenRange(myRange)
Loop
End Sub
Public Function NextParenRange(ByVal ipRange As Word.Range) As Word.Range
Const OpenP As String = "("
Const CloseP As String = ")"
Dim myRange As Word.Range
Set myRange = ipRange.Duplicate
'If myRange.Start <> myRange.End Then myRange.Collapse direction:=wdCollapseStart
'exit if no parentheses exist
'Debug.Print myRange.Start
If myRange.MoveUntil(cset:=OpenP) = 0 Then
Set NextParenRange = Nothing
Exit Function
Else
'Debug.Print myRange.Start
Dim myParenCount As Long
myParenCount = 1
myRange.MoveEnd Count:=1
End If
Do Until myParenCount = 0
' allows VBA to respond to a break key press
DoEvents
' if we run out of parentheses before we get back to zero then flag an error
If myRange.MoveEndUntil(cset:=OpenP & CloseP) = 0 Then
VBA.Err.Raise 17, "Unbalanced parentheses in document"
End If
myRange.MoveEnd Count:=1
'Debug.Print myRange.Characters.Last.Text
'Debug.Print myRange.Characters.Last.Next.Text
myParenCount = myParenCount + IIf(myRange.Characters.Last.Text = OpenP, 1, -1)
Loop
Set NextParenRange = myRange.Duplicate
End Function