Sub TagSelectedOrItalic()
' Paul Beverley - Version 13.04.16
' Add red tags to the selected text or italic text

tagTextSelected = "<IEQ></IEQ>"
tagTextItalic = "<i></i>"

myTrack = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False

If Selection.Start = Selection.End Then
  tagStop = InStr(tagTextItalic, "><")
  startTag = Left(tagTextItalic, tagStop)
  endTag = Mid(tagTextItalic, tagStop + 1)
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Font.Italic = True
    .Wrap = False
    .Replacement.Text = ""
    .Forward = True
    .MatchWildcards = False
    .MatchWholeWord = False
    .MatchSoundsLike = False
    .Execute
  End With
Else
  startTag = Left(tagTextSelected, InStr(tagTextSelected, "><"))
  endTag = Mid(tagTextSelected, InStr(tagTextSelected, "><") + 1)
End If

startNow = Selection.Start
Selection.Collapse wdCollapseEnd
Selection.TypeText Text:=endTag
endNow = Selection.End
Selection.MoveStart , -(Len(endTag))

' Here's where the colour is added
Selection.Font.Color = wdColorRed
Selection.End = startNow
Selection.TypeText Text:=startTag
Selection.MoveStart , -(Len(startTag))

' And here
Selection.Font.Color = wdColorRed
Selection.Start = endNow + Len(startTag)
Selection.Collapse wdCollapseEnd
ActiveDocument.TrackRevisions = myTrack
End Sub