Stop code running if text has already been inserted

[GenuineGin]

Hi,

I have a macro in word that opens and searches Column 3 of an excel spreadsheet for matching text. If the text is present, the macro inserts the text from an adjacent spreadsheet column (Column 1) after the matching text in the word document, but only in the first instance.


Sub FindReplaceExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim idx As Integer
Dim strTexttoFind As String
Dim strTexttoInsert As String
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.WOrkbooks.Open("R:\CURRENT PROJECTS\10. REPORT TEMPLATES\Report Content\Species List.xlsx")
With xlWB.Sheets(1).Range("A1")
For idx = 1 To .CurrentRegion.Rows.Count
strTexttoFind = .Offset(idx - 1, 3)
strTexttoInsert = " " & .Offset(idx - 1, 1)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = strTexttoFind
If .Execute = True Then
Selection.InsertAfter strTexttoInsert
End If
End With
With Selection.Find
.Text = strTexttoInsert
If .Execute = True Then
Selection.ItalicRun
Selection.Range.HighlightColorIndex = wdTurquoise
End If
End With
Next
End With
xlWB.Close False
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

This is working great, except each time the code is run, if the word has already been inserted, it ends up being repeated. I only want the code to run if the text has not already been inserted. To do this I'm thinking I need the macro to search the word document for text matching the contents of the spreadsheet column 1 and only run the rest of the code if a match cannot be found.

I tried to do this:


Sub FindReplaceExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim idx As Integer
Dim idx2 As Integer
Dim strTexttoFind As String
Dim strTexttoFind2 As String
Dim strTexttoInsert As String
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.WOrkbooks.Open("R:\CURRENT PROJECTS\10. REPORT TEMPLATES\Report Content\Species List.xlsx")
With xlWB.Sheets(1).Range("A1")
For idx = 1 To .CurrentRegion.Rows.Count
strTexttoFind = .Offset(idx - 1, 1)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = strTexttoFind
If .Execute = False Then
'Original code
With xlWB.Sheets(1).Range("A1")
For idx2 = 1 To .CurrentRegion.Rows.Count
strTexttoFind2 = .Offset(idx - 1, 3)
strTexttoInsert = " " & .Offset(idx2 - 1, 1)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = strTexttoFind2
If .Execute = True Then
Selection.InsertAfter strTexttoInsert
End If
End With
With Selection.Find
.Text = strTexttoInsert
If .Execute = True Then
Selection.ItalicRun
Selection.Range.HighlightColorIndex = wdTurquoise
End If
End With
Next
End With
'Original Code Ends
Else
End If
End With
Next
End With
xlWB.Close False
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

It seemed to skip the text that had already been inserted, but then proceeded to insert text from EVERY cell in Column 1! So I must have done something very wrong! :doh:

I'd be very grateful if someone could fix it for me!

Gin