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

 

[leever]

Hi there. Thank you so much for this. Very helpful. I have a follow-up question I’m hoping you can help me with. I have the data below:

I have edited the code to sArr = Split("Wa,Ne,Ky", ",")

Is there a way to ignore footnotes for specific words (Walter, Newman, Kylie). The footnote numbers appear after every “Wa”, “Ne”, and “Ky”. Thank you again.

 

[Macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z]{2}[!^13]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    i = i + 1
    .Footnotes.Add Range:=.Duplicate.Characters.Last, Text:="Written in data"
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

 

[Macropod]

The previous macro handles text such as you have in your first post, without the need for an array of possible errors. The following macro extends that to deal with tabs and manual line-breaks in the data as well as with erroneous content in tables and at line ends, per post #5, above - again, without the need for an array of possible errors.

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z]{2}[!^t^13^l]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    i = i + 1: .Footnotes.Add Range:=.Duplicate.Characters.Last, Text:="Written in data"
    .Collapse wdCollapseEnd
  Loop
  .Start = ActiveDocument.Range.Start
  .Find.Text = "<[A-Z][a-z]>"
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      If .Characters.Last = .Cells(1).Range.Characters.Last.Previous Then
        i = i + 1: .Footnotes.Add Range:=.Duplicate.Characters.Last, Text:="Written in data"
      End If
    ElseIf .Characters.Last.Next Like "[" & Chr(11) & vbCr & vbTab & "]" Then
      i = i + 1: .Footnotes.Add Range:=.Duplicate.Characters.Last, Text:="Written in data"
    End If
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub