Find only the first Instance of Words -Then Do Replacement

[dan88]

Hello,

I would be grateful for help on my code below.



I just want to find the first instance of each words in the array and then do a replace task on it.

Example find the first instance of Air Boat then do a replacement on that only. Ignore all other Air Boats

Sub Insert_After_First_Instance()

    Dim oRng As Word.Range
    Dim arrWords
    Dim i As Long
    arrWords = Array("Air Boat", "Power Boat", "Ferry")
    arrInsertAfter = Array("AB123", "PB456", "F123")
  
For i = 0 To UBound(arrWords)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = arrWords(i)
            
            .MatchWholeWord = True
            .Replacement.Text = arrWords(i) & arrInsertAfter(i)
   
            .Execute Replace:=wdReplaceAll
        End With
    Next

End Sub

any ideas are welcome thank you

dan

[macropod]

Change:
wdReplaceAll
to:
wdReplaceOne

[dan88]

Thanks Paul,

I missed that one right under my nose

My skills are not strong enough for the 2nd instance so ill leave it be

cheers

dan

[macropod]

Originally Posted by dan88

My skills are not strong enough for the 2nd instance so ill leave it be

If you want to replace the first two instances, simply use:
.Execute Replace:=wdReplaceOne
.Execute Replace:=wdReplaceOne

[gmayor]

While Paul's modification works fine, it's a very quiet Sunday morning so ... you could also use

Sub Insert_After_One_Instance()
Dim oRng As Word.Range
Dim arrWords As Variant
Dim arrInsertAfter As Variant
Dim i As Long
    arrWords = Array("Air Boat", "Power Boat", "Ferry")
    arrInsertAfter = Array("AB123", "PB456", "F123")

    For i = 0 To UBound(arrWords)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            Do While .Execute(FindText:=arrWords(i), MatchWholeWord:=True)
                oRng.InsertAfter arrInsertAfter(i)
                Exit Do
            Loop
        End With
    Next i
    Set oRng = Nothing
End Sub

or for two instances (or more) add a counter e.g.

Sub Insert_After_Two_Instances()
Dim oRng As Word.Range
Dim arrWords As Variant
Dim arrInsertAfter As Variant
Dim i As Long, j As Long
    arrWords = Array("Air Boat", "Power Boat", "Ferry")
    arrInsertAfter = Array("AB123", "PB456", "F123")

    For i = 0 To UBound(arrWords)
        Set oRng = ActiveDocument.Range
        j = 0
        With oRng.Find
            Do While .Execute(FindText:=arrWords(i), MatchWholeWord:=True)
                oRng.InsertAfter arrInsertAfter(i)
                j = j + 1
                oRng.Collapse 0
                If j = 2 Then Exit Do 'Number of instances to process
            Loop
        End With
    Next i
    Set oRng = Nothing
End Sub

[macropod]

Or, to update just the 2nd instance:

Sub Demo()
Dim arrFnd, arrRep, i As Long, j As Long
arrFnd = Array("Air Boat", "Power Boat", "Ferry")
arrRep = Array("AB123", "PB456", "F123")
For i = 0 To UBound(arrFnd)
  j = 0
  With ActiveDocument.Range
    With .Find
      .Text = arrFnd(i)
      .MatchWholeWord = True
      .Wrap = wdFindStop
      .Execute
    End With
    Do While .Find.Found
      j = j + 1
      If j = 2 Then
        .InsertAfter arrRep(i)
        Exit Do
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next i
End Sub

[dan88]

Hi Paul and Graham,

many thanks for extending the code in a more advanced direction.

I have found new combinations of replacements I can do now, which I didn't know was possible before.

The counter will be very handy

thanks ever so much again

very appreciative of your generous efforts

dan