Get data from excel to office word array using VBA - arrays

Question

I have an excel file where are stored in columns some text and keywords.
I want to use the data in excel to make some Advanced search in Word using vba. But I'm getting an error trying to transpose the data from excel cells to an array in vba word.
I have used the transpose excel function but it doesn't handle more than 255 characters so I can't get cell's value that exceeds 255 characters.
I would be thankfull if someone could give me a hand.
Option Explicit
Dim strArray
Dim range As range
Dim i As Long
Dim numberOfUniqMatches As Integer
Dim totalMatches As Integer
Sub HighlightMatchesAndSummarize()
totalMatches = 0
'************************************ GET DATA FROM EXCEL ***************************************
Dim xlApp As Object
Dim xlBook As Object
Const strWorkBookName As String = "D:\keyword_source_3.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkBookName)
'xlApp.Visible = True
xlApp.Visible = False
'transpose excel cells in our arrays
strArray = xlApp.Transpose(xlApp.ActiveSheet.range("A1:A20" & AlRow).Value)
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
'
' End of data extraction
'/******************************** SEARCH LOOP START **********************************
For i = 1 To UBound(strArray)
numberOfUniqMatches = 0
Set range = ActiveDocument.range
With range.Find
.Text = strArray(i)
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchFuzzy = False
.MatchPhrase = True
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
numberOfUniqMatches = numberOfUniqMatches + 1
totalMatches = totalMatches + 1
range.HighlightColorIndex = wdYellow
Loop
End With
Next
'
' End of search loop
' Display message if no matching word is found
If totalMatches <= 0 Then
MsgBox "Sorry! No matching keyword found."
Else
MsgBox "Search ended: " & totalMatches & " matching word(s)."
End If
End Sub

Answer 1

Change this:
strArray = xlApp.Transpose(xlApp.ActiveSheet.range("A1:A20" & AlRow).Value)
To:
'remove the transpose (and fix the range...)
strArray = xlApp.ActiveSheet.range("A1:A" & AlRow).Value
Then in your loop:
For i = 1 To UBound(strArray, 1) '<<<<<<<
numberOfUniqMatches = 0
Set range = ActiveDocument.range
With range.Find
.Text = strArray(i, 1) '<<<<<<<
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchFuzzy = False
.MatchPhrase = True
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
numberOfUniqMatches = numberOfUniqMatches + 1
totalMatches = totalMatches + 1
range.HighlightColorIndex = wdYellow
Loop
End With
Next

Answer 2

Saerch for Byte in your code and replace it by Long. Ctrl+H is the shortcut for Replace.