Sub HighlightWithColor_Cyan()
     Call HighlightWithColor(wdTurquoise, "Tracking")
End Sub

Sub HighlightWithColor_Green()
     Call HighlightWithColor(wdBrightGreen, "Tracking")
End Sub

Sub HighlightWithColor_NoColor()
    Call HighlightWithColor(wdNoHighlight, "Tracking")
End Sub

Sub HighlightWithColor_Pink()
     Call HighlightWithColor(wdPink, "Tracking")
End Sub

Sub HighlightWithColor_Red()
     Call HighlightWithColor(wdRed, "Tracking")
End Sub

Sub HighlightWithColor_Yellow()
     Call HighlightWithColor(wdYellow, "Tracking")
End Sub

Private Sub HighlightWithColor(iColorIndex As Integer, bTrack As String)
    
    'Updated 2020-06-16
    '
    'This macro subroutine highlights the selected content and changes tracking of the highlighting based on
    'the value of the bTrack parameter
    '
    'Written by Michael Schuler (https://bergerplusschuler.com)

    Dim bCurrentRevision As Boolean
    Dim bCurrentTracking As Boolean
    Dim lTrailingSpaceFlag As Long
    Dim rSel As Range
    Const sDialogTitle As String = "Highlight Selection"
    
    On Error GoTo Err_Msg
    
    If Selection.Type = wdSelectionIP Then Selection.Expand wdWord
    
    bCurrentRevision = ActiveDocument.TrackRevisions
    bCurrentTracking = ActiveDocument.TrackFormatting
    
    If bTrack = "True" Then
            ActiveDocument.TrackRevisions = True
            ActiveDocument.TrackFormatting = True
        ElseIf bTrack = "False" Then
            ActiveDocument.TrackRevisions = False
            ActiveDocument.TrackFormatting = False
        ElseIf bTrack = "Tracking" Then
            ActiveDocument.TrackFormatting = ActiveDocument.TrackRevisions
    End If
    Set rSel = Selection.Range

    rSel.HighlightColorIndex = iColorIndex
    ActiveDocument.TrackRevisions = bCurrentRevision
    ActiveDocument.TrackFormatting = bCurrentTracking

Macroend:
Exit Sub

Err_Msg:
    MsgBox "The macro has encountered an error." & vbCrLf & Err.Number & ": " & Err.description, vbCritical, sDialogTitle

End Sub