Microsoft Word Macro - Adding Footnote to Specific Text

[leever]

Hello. I am trying to create a macro that adds footnotes in a Word document when there is specific text. For example, I have a list of names and addresses with common occurring typos.

From the data, the text that I would want footnoted are “SMith”, “NEw”, “ORLeans”.

This is the code I have but it is not giving me what I want.
---
Public Sub HighlightMultipleWords()
Application.ScreenUpdating = False

Dim sArr() As String
Dim rTmp As Range
Dim x As Long

Set rTmp = ActiveDocument.Range
sArr = Split("SMith”, “NEw”, “ORLeans ")
For x = 0 To UBound(sArr)

With rTmp.Find
.Text = sArr(x)
.Replacement.Text = sArr(x)
ActiveDocument.Footnotes.Add rTmp, Text:="Written in data"
End With
Next

End Sub
---

Any help would be greatly appreciated. Thank you!

 

[Artik]

First, correct the line to the following.

sArr = Split("SMith,NEw,ORLeans", ",")

And then keep fighting.

Artik

 

[leever]

First, correct the line to the following.

sArr = Split("SMith,NEw,ORLeans", ",")

And then keep fighting.

Artik

Thank you Artik. I can't get the footnote numbers to come after the words. "123" shows up after the block of text. Any further tips would be greatly appreciated. Thank you.

 

[Artik]

Try this

Sub HighlightMultipleWords_2()
    Dim sArr() As String
    Dim rTmp As Range
    Dim x As Long

    Application.ScreenUpdating = False

    sArr = Split("SMith,NEw,ORLeans", ",")

    For x = 0 To UBound(sArr)

        Set rTmp = ActiveDocument.Range

        With rTmp.Find
            .Text = sArr(x)
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .MatchCase = True

            Do While .Execute
                ActiveDocument.Footnotes.Add Range:=rTmp, Text:="Note to the phrase '" & sArr(x) & "'" 
                rTmp.Collapse Direction:=wdCollapseEnd
            Loop

        End With

    Next x

    Application.ScreenUpdating = True
End Sub

Artik