Change the macro as follows:
Code:
Sub Highlight_Words_From_Excel_NamedRange()
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Nov 2021
Const strRange As String = "WordList" 'The named Excel range
Dim strWorkbook As String
Dim arr() As Variant
Dim lngRows As Long
Dim oRng As Range
Dim strFind As String
Dim FSO As Object
strWorkbook = Environ("HOMEPATH") & "\files\test.xlsx"
'or
'strWorkbook = Environ("USERPROFILE") & "\files\test.xlsx"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(strWorkbook) Then
arr = xlFillArray(strWorkbook, strRange)
For lngRows = 0 To UBound(arr, 2)
strFind = arr(0, lngRows)
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(findText:=strFind)
oRng.HighlightColorIndex = wdYellow
oRng.Collapse 0
Loop
End With
Next lngRows
Else
MsgBox "The file '" & strWorkbook & "' does not exist!", vbCritical
End If
lbl_Exit:
Set oRng = Nothing
Set FSO = Nothing
Exit Sub
End Sub
Note that Environ("HOMEPATH") here does not include C:\. That may be related to Sharepoint which I don't have access to.The alternative will include the C:\. I have added error trapping for the file.