Correcting this Word macro to call data from Excel worksheet as suggested

Correcting this Word macro to call data from Excel worksheet as suggested

I'm running this macro in MS Word and it works well but I have a lot more
words to replace. It suggests I can call the data from an Excel worksheet.



Suggested on line 33 of the code below:
"Note: Data arrays are used in this example. In practice the data could
come from a Word table, Excel worksheet or other data source."
arrEng = Split("God H430,heaven H8064,earth H776,waters H4325,good H2896",
",")
arrHeb = Split("Elohim H430,shamayim H8064,aretz H776,mayim H4325,tov
H2896", ",")



How is this done?
What does my .xlsx file need to look like? old words on Column A, new
words on Column B?
How do I tell this macro to go to that file and look for the words to
replace? (my knowledge of VBA is: I started today! :) Thanks :)



Option Explicit
Dim m_oCol1 As Collection
Dim m_oCol2 As Collection
Sub ReplaceWordsAndDefineFootnotes()
Dim clsTL As clsTerms
Dim lngIndex As Long
Set clsTL = New clsTerms
Set clsTL.Items = DefinedTerms
Set m_oCol1 = New Collection
For lngIndex = 1 To clsTL.Count
'Replace each defined English word with it Hebrew equivelent.
ReplaceWords clsTL.Items(lngIndex).EnglishTerm,
clsTL.Items(lngIndex).HebrewTerm
Next lngIndex
Underline_And_DefineFootnote
For lngIndex = 1 To clsTL.Count
'Replace temporary footnote text with with class defined footnote
text.
FixFootnotes clsTL.Items(lngIndex).HebrewTerm,
clsTL.Items(lngIndex).FootnoteText
Next lngIndex
lbl_Exit:
Exit Sub
End Sub
Function DefinedTerms() As Collection
Dim arrEng() As String
Dim arrHeb() As String
Dim lngIndex As Long
Dim oCol As Collection
Dim Term As clsTerm
'Note: Data arrays are used in this example. In practice the data
could come from a Word table, Excel worksheet or other data source.
arrEng = Split("God H430,heaven H8064,earth H776,waters H4325,good
H2896", ",")
arrHeb = Split("Elohim H430,shamayim H8064,aretz H776,mayim H4325,tov
H2896", ",")
Set oCol = New Collection
'Put data in the collection.
For lngIndex = 0 To UBound(arrEng)
Set Term = New clsTerm
Term.EnglishTerm = arrEng(lngIndex)
Term.HebrewTerm = arrHeb(lngIndex)
Term.FootnoteText = arrEng(lngIndex) & ":" & arrHeb(lngIndex)
oCol.Add Term, Term.EnglishTerm
Next lngIndex
Set DefinedTerms = oCol
lbl_Exit:
Exit Function
End Function
Sub ReplaceWords(ByVal strFind As String, ByVal strReplaceWith As String)
Dim oRng As Word.Range
'Add each term processed to a collection.
m_oCol1.Add UCase(strReplaceWith), UCase(strReplaceWith)
Set oRng = ActiveDocument.Range
'Replace each instance of the English word with its Hebrew equivalent.
With oRng.Find
.Text = strFind
.Replacement.Text = strReplaceWith
.MatchWholeWord = True
.MatchCase = False
.Execute Replace:=wdReplaceAll
End With
lbl_Exit:
Exit Sub
End Sub
Sub Underline_And_DefineFootnote()
Dim oRng As Word.Range
Dim lngIndex As Long
Dim oWord As Word.Range
Dim strWord As String
Dim lngCounter As Long
Dim lngPages As Long
With ActiveDocument
Set oRng = .Range
lngPages = .ComputeStatistics(wdStatisticPages)
For lngIndex = 1 To lngPages
Reprocess:
Set m_oCol2 = New Collection
Set oRng = oRng.GoTo(What:=wdGoToPage, Name:=lngIndex)
Set oRng = oRng.GoTo(What:=wdGoToBookmark, Name:="\page")
lngCounter = 1
With oRng
For Each oWord In oRng.Words
'Modify the word range to strip off white space. We
want only the text portion of the word range.
strWord = UCase(Trim(oWord.Text))
oWord.Collapse wdCollapseStart
oWord.MoveEnd wdCharacter, Len(strWord)
If oWord.Characters.Last = Chr(160) Then oWord.MoveEnd
wdCharacter, -1
'We need to know if the text defined by the word range
is a word we want to process.
'We added all of those words to a collection during
the find and replace process.
'If we try to add one of those words to the collection
again then it will error and we will know _
we are dealing with a word we want to process.
On Error Resume Next
m_oCol1.Add strWord, strWord
If Err.Number <> 0 Then
On Error GoTo 0
On Error Resume Next
'We only want to underline and footnote the first
instance of the term on each page.
'So add the term and key to a collection.
m_oCol2.Add strWord, strWord
If Err.Number = 0 Then
'There was no error so underline the term and
footnote it.
oWord.Font.Underline = 1
On Error GoTo 0
ActiveDocument.Footnotes.Add oWord,
CStr(lngCounter), LCase(strWord)
lngCounter = lngCounter + 1
End If
Else
'The word wasn't a word we want to process so
remove it from the collection.
m_oCol1.Remove m_oCol1.Count
End If
Next oWord
End With
'Since processing words will add footnotes, the length of the
document will increase.
'I'm using this method to reenter the processing loop.
lngPages = .ComputeStatistics(wdStatisticPages)
If lngIndex < lngPages Then
lngIndex = lngIndex + 1
GoTo Reprocess
End If
Next lngIndex
End With
Set oRng = Nothing
End Sub
Sub FixFootnotes(ByVal strFind As String, ByVal strReplaceWith As String)
Dim oRng As Word.Range
m_oCol1.Add UCase(strReplaceWith), UCase(strReplaceWith)
Set oRng = ActiveDocument.StoryRanges(wdFootnotesStory)
With oRng.Find
.Text = strFind
.Replacement.Text = strReplaceWith
.MatchWholeWord = True
.MatchCase = False 'True
.Execute Replace:=wdReplaceAll
End With
lbl_Exit:
Exit Sub
End Sub