Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_RANGE1 As String = "A1:A300" '<=== change Range of cells to suit
Const WS_RANGE2 As String = "B1:B300" '<=== change Range of cells to suit
On Error GoTo err_handler
Application.EnableEvents = False
If Not Application.Intersect(Target, Range(WS_RANGE1)) 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
ElseIf Application.Intersect(Target, Range(WS_RANGE2)) Is Nothing Then
With Target
.Font.Name = "X"
Select Case .Value
Case "X": .Value = ""
Case "": .Value = "X"
Case Else: .Value = ""
End Select
.Offset(1, 0).Select
End With
End If
err_handler:
Application.EnableEvents = True
End Sub
Bookmarks