Multiple Find and Replace

[thinksalot]

I wrote this macro to find terms and only replace the first occurrence with term and either a registration mark or a trademark. It works beautifully. However, I am still faced with three issues.

I would like to skip terms that are italicized (done) or in Courier font.

I would like to include Arial in my search as well, as I will replace the first instance of the word whether it's in Times New Roman or Arial font.

I would also like to include footnotes in my search. I have seen a few posts on the subject, but none seem to work for me.

If you have any ideas or solutions, feel free to share. Thank you.

[vba]
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Windows"
.Replacement.Text = "Windows?"
.Font.Italic = False
.Font.Name = "Times New Roman"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = True
.MatchWholeWord = True
End With
Selection.Find.Execute
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=3, Name:=""
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute
End With
[/vba]

I need to duplicate this code for each term, so have replaced text with words Bluetooth(R), Proctor & Gamble(R), stuff like that, and am merely using a list of terms in the various fonts (Ariel, Courier and Times New Roman) to conduct the search as it works the same. I have a real document but cannot share here.

Windows
Bluetooth
Proctor & Gamble
Windows
Bluetooth
Proctor & Gamble
Windows
Bluetooth
Proctor & Gamble

This find and replace starts in the third section of my document, as I want to avoid the cover page and Table of Contents.

[mdmackillop]

Hi,
Welcome to VBAX.
If you select your code and click the VBA button, it will format as shown, making it more readable. With regard to your question, can you post some sample text? (Use Manage Attachments in the Go Advanced section)
Regards
MD

[mdmackillop]

Have a look at the following. I've no time just now to look at footnotes(never used them), but maybe someone else can pick this up.

[vba]
Sub Test()
Dim MyText(2, 2)
MyText(0, 0) = "Windows"
MyText(0, 1) = "Windows®"
MyText(1, 0) = "Test"
MyText(1, 1) = "Test®"

Selection.HomeKey Unit:=wdStory
For i = 0 To 1
Selection.Find.ClearFormatting
With Selection.Find
.Text = MyText(i, 0)
End With
Selection.Find.Execute
Do
With Selection.Font
If Not .Name = "Courier" Then
'or
'If .Name = "Arial" Or .Name = "Times New Roman" Then
If Not .Italic = True Then
Selection.TypeText MyText(i, 1)
Exit Do
End If
End If
End With
Selection.Find.Execute
Loop
Selection.HomeKey Unit:=wdStory
Next i
End Sub

[/vba]

[thinksalot]

This is great; the concept is exactly what I want. BUT, I'm doing something wrong when I try
to add more terms. This is how my code stands now; I did try to change the #2 to (3, 3)
to see if I needed to increase those numbers.

[vba]
Dim MyText(2, 2)
MyText(0, 0) = "Windows"
MyText(0, 1) = "Windows®"
MyText(1, 0) = "Test"
MyText(1, 1) = "Test®"
MyText(2, 0) = "ARM"
MyText(2, 1) = "ARM®"

I understand that I am searching for MyText(i, 0) and replacing it with MyText(i, 1),
where i is the number given to the term on the list.

.Text = MyText(i, 0)

Selection.TypeText MyText(i, 1)
[/vba]

Still don't see my mistake. Any help is very much appreciated. Thanks again.

[mdmackillop]

This array is 2 columns wide x multiple rows. To add more data, you need to add more rows only, hence for 10 sets of substitutes you need
Dim MyText(10,2)
Arrays by default use 0 as the base number for the array index, so the first pair are assigned to MyText(0,0) and (0,1). The tenth pair would be assigned to (9,0) and (9,1). In this case your loop would start
For i = 0 to 9.
Arrays can be made Dynamic, where flexibility is required. Check them out in your Help files.