Sub ReplacefromTXT()
'Graham Mayor - https://www.gmayor.com - Last updated - 19 Jan 2023
Dim FSO As Object, oFile As Object
Dim arrFind() As String, sFind As String
Dim oDoc As Document
Dim i As Integer
Const sName As String = "C:\Test\Test.txt" ' change this to your text file full name

       
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = FSO.OpenTextFile(sName, 1)
    arrFind = Split(oFile.ReadAll, vbNewLine)

    Set oDoc = ActiveDocument
    Options.DefaultHighlightColorIndex = wdRed
    With oDoc.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Bold = True
        .Replacement.Highlight = True
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWholeWord = False
        .MatchCase = True
        .MatchWildcards = False
        For i = LBound(arrFind) To UBound(arrFind)
            sFind = Trim(arrFind(i))
            If Len(sFind) > 1 Then
                .Text = sFind
                .Execute Replace:=wdReplaceAll
            End If
        Next i
    End With
lbl_Exit:
    Set FSO = Nothing
    Set oFile = Nothing
    Set oDoc = Nothing
    Exit Sub
End Sub