VBA using excel data to search word document & pasting result into a table

Question

So I want to be able to search a word document (roughly 300 pages) and find certain phrases (one word or two words seperated by a space) (eg: Nationwide/Phrase 2/Phrase 3) which I have in column 'A' of a separate excel document (C:/Test.xlsx). Then this 'phrase' would be coiped and pasted into a table in another word document along with the context (20 characters before & after the 'phrase') along the page/line number it was found. Now someone (and I'm truly thankful) had created the following macro which used an array. Unfortunatley there could be approx 100-200 words that I would be looking for and I can't get it to include them all in the array or use the excel document as the data.

Here is the code so far

Many thanks for looking at this!!!!!

    Sub CopyKeywordPlusContext()
'Modified 2-17-2015 GKM
'Makro created on 22.01.2013
Dim oDoc As Document, oDocRecord As Document
Dim strSearch As String, arrSearch
Dim lngCharTrailing As Long, lngCharLeading As Long, lngIndex As Long, lngCount As Long
Dim lngPgNum, lngLineNum As Integer
Dim oRng As Word.Range, oRngSpan As Word.Range
Dim bFound As Boolean
Dim oTbl As Word.Table
  strSearch = vbNullString
Dim xl As Object
Set xl = GetObject(, "Excel.Application")
arrSearch = xl.transpose(xl.activesheet.Range("A1:A14").Value)
  lngCharLeading = 20
  lngCharTrailing = 20
  Set oDoc = ActiveDocument
  For lngIndex = 1 To UBound(arrSearch)
    ResetFRParams
    bFound = False
    lngCount = 0
    Set oRng = oDoc.Range
    With oRng.Find
      .Text = LCase(arrSearch(lngIndex))
      While .Execute
        bFound = True
        If oDocRecord Is Nothing Then
          Set oDocRecord = Documents.Add
          Set oTbl = oDocRecord.Tables.Add(oDocRecord.Range, 1, 2)
        End If
        lngCount = lngCount + 1
        If lngCount = 1 Then
          oTbl.Rows.Add
          With oTbl.Rows.Last.Previous
            .Cells.Merge
            With .Cells(1).Range
              .Text = "Search results for """ & arrSearch(lngIndex) & """ + context in " & """" & oDoc.Name & """"
              .Font.Bold = True
            End With
          End With
        End If
        Set oRngSpan = oRng.Duplicate
        oRngSpan.Select
        lngPgNum = Selection.Information(wdActiveEndPageNumber)
        lngLineNum = Selection.Information(wdFirstCharacterLineNumber)
        With oRngSpan
          .MoveStart wdCharacter, -lngCharLeading
          .MoveEnd wdCharacter, lngCharTrailing
          Do While oRngSpan.Characters.First = vbCr
            oRngSpan.MoveStart wdCharacter, -1
          Loop
          Do While oRngSpan.Characters.Last = vbCr
            oRngSpan.MoveEnd wdCharacter, 1
            If oRngSpan.End = oDoc.Range.End Then
              oRngSpan.End = oRngSpan.End - 1
              Exit Do
            End If
          Loop
        End With
        oTbl.Rows.Last.Range.Cells(1).Range.Text = Trim(oRngSpan.Text)
        oTbl.Rows.Last.Range.Cells(2).Range.Text = "Page: " & lngPgNum & " Line: " & lngLineNum
        oTbl.Rows.Add
      Wend
    End With
    If bFound Then
      ResetFRParams
      With oDocRecord.Range.Find
        .Text = LCase(arrSearch(lngIndex))
        .Replacement.Text = "^&"
        .Replacement.Highlight = True
        .Format = True
        .Execute Replace:=wdReplaceAll
      End With
    End If
  Next lngIndex
  oTbl.Rows.Last.Delete
End Sub
Sub ResetFRParams()
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Replacement.Highlight = False
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
lbl_Exit:
  Exit Sub
End Sub

Answer 1

Answer by the man, the legend Tim Williams!!!! Truly thankful!!!

   Sub CopyKeywordPlusContext()
'Modified 2-17-2015 GKM
'Makro created on 22.01.2013
Dim oDoc As Document, oDocRecord As Document
Dim strSearch As String, arrSearch
Dim lngCharTrailing As Long, lngCharLeading As Long, lngIndex As Long, lngCount As Long
Dim lngPgNum, lngLineNum As Integer
Dim oRng As Word.Range, oRngSpan As Word.Range
Dim bFound As Boolean
Dim oTbl As Word.Table
  strSearch = vbNullString
Dim xl As Object
Set xl = GetObject(, "Excel.Application")
arrSearch = xl.transpose(xl.activesheet.Range("A1:A14").Value)
  lngCharLeading = 20
  lngCharTrailing = 20
  Set oDoc = ActiveDocument
  For lngIndex = 1 To UBound(arrSearch)
    ResetFRParams
    bFound = False
    lngCount = 0
    Set oRng = oDoc.Range
    With oRng.Find
      .Text = LCase(arrSearch(lngIndex))
      While .Execute
        bFound = True
        If oDocRecord Is Nothing Then
          Set oDocRecord = Documents.Add
          Set oTbl = oDocRecord.Tables.Add(oDocRecord.Range, 1, 2)
        End If
        lngCount = lngCount + 1
        If lngCount = 1 Then
          oTbl.Rows.Add
          With oTbl.Rows.Last.Previous
            .Cells.Merge
            With .Cells(1).Range
              .Text = "Search results for """ & arrSearch(lngIndex) & """ + context in " & """" & oDoc.Name & """"
              .Font.Bold = True
            End With
          End With
        End If
        Set oRngSpan = oRng.Duplicate
        oRngSpan.Select
        lngPgNum = Selection.Information(wdActiveEndPageNumber)
        lngLineNum = Selection.Information(wdFirstCharacterLineNumber)
        With oRngSpan
          .MoveStart wdCharacter, -lngCharLeading
          .MoveEnd wdCharacter, lngCharTrailing
          Do While oRngSpan.Characters.First = vbCr
            oRngSpan.MoveStart wdCharacter, -1
          Loop
          Do While oRngSpan.Characters.Last = vbCr
            oRngSpan.MoveEnd wdCharacter, 1
            If oRngSpan.End = oDoc.Range.End Then
              oRngSpan.End = oRngSpan.End - 1
              Exit Do
            End If
          Loop
        End With
        oTbl.Rows.Last.Range.Cells(1).Range.Text = Trim(oRngSpan.Text)
        oTbl.Rows.Last.Range.Cells(2).Range.Text = "Page: " & lngPgNum & " Line: " & lngLineNum
        oTbl.Rows.Add
      Wend
    End With
    If bFound Then
      ResetFRParams
      With oDocRecord.Range.Find
        .Text = LCase(arrSearch(lngIndex))
        .Replacement.Text = "^&"
        .Replacement.Highlight = True
        .Format = True
        .Execute Replace:=wdReplaceAll
      End With
    End If
  Next lngIndex
  oTbl.Rows.Last.Delete
End Sub
Sub ResetFRParams()
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Replacement.Highlight = False
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
lbl_Exit:
  Exit Sub
End Sub

Answer 2

To populate the array with the values in colA of the active sheet in an open instance of Excel (note there can be only one insatance of excel open or it may get the wrong instance):

Replace

arrSearch = Split("Nationwide,Phrase 2,Phrase 3", ",")

with

Dim xl As Object
Set xl = GetObject(, "Excel.Application")
arrSearch = xl.transpose(xl.activesheet.Range("A1:A14").Value)

and

For lngIndex = 0 To UBound(arrSearch)

with

For lngIndex = 1 To UBound(arrSearch)