Sub QC_Time()
  HighlightPhrases MyAcroFileName:="C:\Users\gontch\Desktop\Phrase Running List.txt", bAll:=True
  HighlightPhrases MyAcroFileName:="C:\Users\gontch\Desktop\Acronyms Running List.txt", bAll:=False
End Sub

Function HighlightPhrases(MyAcroFileName As String, bAll As Boolean)
  Dim MyString As String, rng As Range

  Application.ScreenUpdating = False
    Open MyAcroFileName For Input As #1
      Do While Not EOF(1)                 'loop through the file until the end of file marker is reached
        Line Input #1, MyString           'read line of text, place it in the MyString variable
        Set rng = ActiveDocument.Range    'Reset the Range object to the entire current document
        With rng.Find
          .Text = MyString
          .Replacement.Text = MyString
          .MatchCase = False
          .MatchWholeWord = True
          .Forward = True
          .Replacement.Highlight = True
          If bAll Then
            Options.DefaultHighlightColorIndex = wdPink
            .Execute Replace:=wdReplaceAll
          End If
          Options.DefaultHighlightColorIndex = wdYellow
          .Execute Replace:=wdReplaceOne
         End With
      Loop
    Close #1          'close the text file
  Application.ScreenUpdating = True
End Function