View Single Post
 
Old 11-04-2021, 07:04 AM
gomezaka gomezaka is offline Windows 10 Office 2019
Novice
 
Join Date: Oct 2021
Posts: 4
gomezaka is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
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.
Thank you so very much, this was just what I needed.
Reply With Quote