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.