Hey, picky!![]()
[vba]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE_NOT_PH As String = "C:J"
Const WS_RANGE_PH As String = "K:K"
Const CI_EPA As Long = 52479
Const CI_STATE_PERMIT As Long = 65535
Const CI_BOTH As Long = 9803737
Dim wsCriteria As Worksheet
On Error GoTo ws_exit
Application.EnableEvents = False
Set wsCriteria = Worksheets("Criteria")
If Not Intersect(Target, Me.Range(WS_RANGE_NOT_PH)) Is Nothing Then
With Target
If .Row > 2 Then
If .Value <> "<0.1" And .Value <> "" Then
.Interior.ColorIndex = xlColorIndexNone
.Font.Bold = False
Select Case True
Case .Value > wsCriteria.Cells(3, .Column - 1).Value2 And _
.Value > wsCriteria.Cells(4, .Column - 1).Value2:
.Interior.Color = CI_BOTH
.Font.Bold = True
Case .Value > wsCriteria.Cells(3, .Column - 1).Value2:
.Interior.Color = CI_EPA
.Font.Bold = True
Case .Value > wsCriteria.Cells(4, .Column - 1).Value2:
.Interior.Color = CI_STATE_PERMIT
.Font.Bold = True
End Select
End If
End If
End With
ElseIf Not Intersect(Target, Me.Range(WS_RANGE_PH)) Is Nothing Then
With Target
If .Row > 2 Then
If .Value <> "<0.1" And .Value <> "" Then
.Interior.ColorIndex = xlColorIndexNone
.Font.Bold = False
Select Case True
Case (.Value < wsCriteria.Cells(3, .Column - 1).Value2 Or _
.Value > wsCriteria.Cells(3, .Column).Value2) And _
(.Value < wsCriteria.Cells(4, .Column - 1).Value2 Or _
.Value > wsCriteria.Cells(4, .Column).Value2):
.Interior.Color = CI_BOTH
.Font.Bold = True
Case .Value < wsCriteria.Cells(3, .Column - 1).Value2 Or _
.Value > wsCriteria.Cells(3, .Column).Value2:
.Interior.Color = CI_EPA
.Font.Bold = True
Case .Value < wsCriteria.Cells(4, .Column - 1).Value2 Or _
.Value > wsCriteria.Cells(4, .Column).Value2:
.Interior.Color = CI_STATE_PERMIT
.Font.Bold = True
End Select
End If
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
[/vba]