Private Sub Worksheet_Change(ByVal zz As Range)
On Error Resume Next
If Intersect(zz, [h16:H46]) Is Nothing Then Exit Sub
If Intersect(zz, [G16:J46]) Is Nothing Then Exit Sub
Select Case zz
Case "": zz.Interior.ColorIndex = 0
Case "Q": zz.Interior.ColorIndex = 3
Case "P": zz.Interior.ColorIndex = 4
Case "R": zz.Interior.ColorIndex = 6
Case "E": zz.Interior.ColorIndex = 5
Case "A": zz.Interior.ColorIndex = 15
Case "D": zz.Interior.ColorIndex = 40
Case Else: zz.Interior.ColorIndex = xlNone
End Select
End Sub