Sub ArrowMaker()
  Dim aRng As Range
  Set aRng = Selection.Range
  With aRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "p"
    .Replacement.Text = Chr(112)
    .Replacement.Font.Name = "Wingdings 3"
    .Replacement.Font.ColorIndex = wdRed
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll

    .Text = "q"
    .Replacement.Text = Chr(113)
    .Replacement.Font.Name = "Wingdings 3"
    .Replacement.Font.ColorIndex = wdGreen
    .Execute Replace:=wdReplaceAll
  End With
End Sub