Sub ReplaceAwithhighlightedtext()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "A^t"
    Do While .Execute
      oRng.HighlightColorIndex = wdRed
      oRng.Collapse wdCollapseEnd
      oRng.HighlightColorIndex = wdAuto
    Loop
  End With
End Sub