Word document highlight issues

Hi I am very new to VBA word programming. I am trying to use regex and word range to select a pattern of words in a word document containing 108 pages to highlight them in Yellow and Green. When I execute the VBA code the word document hangs for a minute of 2 until the code has processed the request. Please check the code below and suggest.

**extract of the word**

*QR233A(M/W)
		if LRD233 xs , LRD237 xs
		   LRDE233 xs , LRDE237 xs
		then @R233A(M/W)
		\
.

*QZR233A(M/W) @R233A(M/W) .

*QAR233A(M/W)
		if LRD233 xs , LRD237 xs
		   LRDE233 xs , LRDE237 xs
		   LARSUDKFTHJS s , LARSUDKFLMS s
		then @R233A(M/W)
		\
.

*R233A(M/W)
	if R233A(M/W) a
	P831 cnf , P833 cnf , L(PB-1)SETTINGAVAIL xs
	LSGPBA xs
then R233A(M/W) s
	P831 cn , P833 cn

**VBA Code**

Sub Reminder_Highlight()

Dim match As VBScript_RegExp_55.match
Dim matches As VBScript_RegExp_55.MatchCollection
Dim myrange As Range
Dim rng3 As Selection
Dim counter As Integer
Set myrange = ActiveDocument.Content
Set rng3 = Selection
Dim Panel_request As Boolean
Dim Reminder_latch As Boolean


With New VBScript_RegExp_55.RegExp
  .Pattern = "(\*Q(A|R|RD)\S+|LRD\S+\s(xs\s+,|xs)|(\@R|\*R)\S+)"
  .Global = True
  Set matches = .Execute(rng3.Text)
End With

Debug.Print matches.Count

For Each match In matches
	
		
	myrange.SetRange rng3.Characters(match.FirstIndex + 1).Start,           rng3.Characters(match.FirstIndex + match.Length).End
	
	If Left(match, 1) = "@" Or Mid(match, 1, 2) = "*R" Then myrange.HighlightColorIndex = wdBrightGreen Else myrange.HighlightColorIndex = wdYellow
	Debug.Print matches.Item(counter) & " "; counter
	counter = counter + 1
  
	
Next


Set matches = Nothing
Set rng2 = Nothing
Set rng1 = Nothing
Set rng3 = Nothing

End Sub

Try this.

Sub HighlightSpecificWords()

    Dim sArr() As String
    Dim rTmp As Range
    Dim x As Long
    sArr = Split("highlight specific words") ' your list
    Options.DefaultHighlightColorIndex = wdYellow

    For x = 0 To UBound(sArr)
  Set rTmp = ActiveDocument.Range
  With rTmp.Find
            .Text = sArr(x)
            .Replacement.Text = sArr(x)
            .Replacement.Highlight = True
            .Execute Replace:=wdReplaceAll
End With
    Next

End Sub

Before:

After: