Can some words in a string be a different color?

I have some cells that change when clicked on, to different texts. "Good, Fair, Bad, and Blank". Is there a code that can be added to make the word "Bad" imput in the color red?
My code is below.

Thanks / Rich

-------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_RANGE As String = "A1:A300" '<=== change Range of cells to suit

On Error GoTo err_handler
Application.EnableEvents = False
If Not Application.Intersect(Target, Range(WS_RANGE)) Is Nothing Then
With Target
.Font.Name = "Good"
Select Case .Value
Case "Good": .Value = "Fair"
Case "Fair": .Value = "Bad"
Case "Bad": .Value = ""
Case Else: .Value = "Good"

End Select
.Offset(2, 0).Select
End With
End If
err_handler:
Application.EnableEvents = True
End Sub

Try this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_RANGE As String = "A1:A300" '<=== change Range of cells to suit

On Error GoTo err_handler

Application.EnableEvents = False
If Not Application.Intersect(Target, Range(WS_RANGE)) Is Nothing Then
   With Target
      .Font.Name = "Good"
         Select Case .Value
         Case "Good"
            .Value = "Fair"
         Case "Fair"
            .Value = "Bad"
            .Font.ColorIndex = 3
         Case "Bad"
            .Value = ""
         Case Else
            .Value = "Good"
      End Select
      .Offset(2, 0).Select
   End With
End If
err_handler:
Application.EnableEvents = True
End Sub