Highlight Text

[preeti]

I m just trying to highlight the text in my document and have written the below macro.
But it fails to highlight the text if same number appears twice.

Sub Highlight1()
Dim Regobject As Object

Dim objMatches, ObjMatch
Dim Pattern1: Pattern1 = "([1][4])\.([0-9]+\s?)"
Set Regobject = CreateObject("VBScript.RegExp")
Regobject.Pattern = Pattern1
Regobject.Global = True
Set objMatches = Regobject.Execute(ActiveDocument.Range.Text)
Dim rng As Range



For Each ObjMatch In objMatches


Set rng = ActiveDocument.Range
With rng.Find
.Text = ObjMatch
.Forward = True
.Execute
If .Found = True Then rng.HighlightColorIndex = wdYellow
End With

Next

End Sub

 

[macropod]

Try:

Sub Highlight1()
Dim Regobject As Object

Dim objMatches, ObjMatch
Dim Pattern1: Pattern1 = "([1][4])\.([0-9]+\s?)"
Set Regobject = CreateObject("VBScript.RegExp")
Regobject.Pattern = Pattern1
Regobject.Global = True
Options.DefaultHighlightColorIndex = wdYellow
With ActiveDocument.Range
  Set objMatches = Regobject.Execute(.Text)

  For Each ObjMatch In objMatches
    With .Find
      .Text = ObjMatch
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      .Forward = True
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
    End With
  Next
End With
End Sub