View Single Post
 
Old 11-03-2021, 09:37 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote