Word Series Find and Replace

[Programmer_n]

This is tricky.

Situation: I have a code that has repeating elements that I need to clean using VBA.

Example:

In the Parse tree below, the elements of parse tree (like S, DT, NN)and each subsequent occurrence needs to be incremented by one, automatically.


Input:
(S
(NP (DT ) (NN ))
(VP (VBZ )
(NN (DT )))
(. .)))

Output expected

(S
(NP (DT ) (NN ))
(VP (VBZ )
(NN1 (DT1 )))
(. .)))

If another DT or NN occurs it is identified as DT2 or NN2.

[gmaxey]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim arrFind() As String
Dim oRng As Range
Dim lngIndex As Long, lngCounter As Long
arrFind = Split("(NN ,(DT ", ",")
For lngIndex = 0 To UBound(arrFind)
Set oRng = ActiveDocument.Range
lngCounter = 0
With oRng.Find
.Text = arrFind(lngIndex)
While .Execute
If lngCounter > 0 Then
oRng.End = oRng.End - 1
oRng.Text = oRng.Text & lngCounter
End If
lngCounter = lngCounter + 1
oRng.Collapse wdCollapseEnd
Wend
End With
Next
lbl_Exit:
Exit Sub

End Sub

[Programmer_n]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim arrFind() As String
Dim oRng As Range
Dim lngIndex As Long, lngCounter As Long
arrFind = Split("(NN ,(DT ", ",")
For lngIndex = 0 To UBound(arrFind)
Set oRng = ActiveDocument.Range
lngCounter = 0
With oRng.Find
.Text = arrFind(lngIndex)
While .Execute
If lngCounter > 0 Then
oRng.End = oRng.End - 1
oRng.Text = oRng.Text & lngCounter
End If
lngCounter = lngCounter + 1
oRng.Collapse wdCollapseEnd
Wend
End With
Next
lbl_Exit:
Exit Sub

End Sub

Thanks. Fantastic code.