Conditionally highlight cells in one column based on text values in another column

Hello all,

I have this macro created below by jbeaucaire (thanks again JB!) and it works awesome, but now I need one modification to it.


Here is what the sub below CURRENTLY does

• Find the column headers named “Customer Number” and “Paper” (always in row 1)
• If any cell in the “Paper” column DOES HAVE the text value “letter” or “legal” equal to the last data row in the “Customer Number” column, highlight the cell GREY.
• If any cell in the “Paper” column DOES NOT HAVE the text value “letter” or “legal” equal to the last data row in the “Customer Number” column, highlight the cell RED.

How can the sub below be modified for this one exception…

• Find a NEW column header named “Writing Tool”
• If any cell in the “Paper” column DOES NOT HAVE the text value “letter” or “legal” equal to the last data row in the “Customer Number” column, highlight the cell RED BUT NOT IF, in that same row in the “Writing Tool” column the text value is “pencil” or “pen”.

• If the cell in the "Writing Tool" column does say “pencil” or “pen” then COMPLETELY IGNORE #3 above and highlight the cell in the “Paper” column GREY no matter what.

Thanks much!

 
Sub Highlight_noncompliant_cells_red()
Dim LR As Long, Ppr As Long, Cst As Long, DeleteMe As Boolean
Dim rng As Range, Cell As Range
Application.ScreenUpdating = False
'Setup
    On Error GoTo ErrorHandler
    Cst = Rows(1).Find(what:="Customer Number", LookAt:=xlPart, MatchCase:=False).Column
    Ppr = Rows(1).Find(what:="Paper", LookAt:=xlPart, MatchCase:=False).Column
    LR = Cells(Rows.Count, Cst).End(xlUp).Row
    DeleteMe = True
    On Error GoTo 0
'Compare Customer values to Customer Number
Set rng = Range(Cells(2, Cst), Cells(LR, Cst))
    For Each Cell In rng
        If Cell.Value <> "" Then
            Select Case LCase(Cells(Cell.Row, Ppr))
                Case "letter", "legal"
                   Cells(Cell.Row, Ppr).Interior.ColorIndex = 15
                Case Else
                    DeleteMe = False
       Cells(Cell.Row, Ppr).Interior.ColorIndex = 3
            End Select
        End If
    Next Cell
 
ErrorHandler:
 '   MsgBox "One of the required columns could not be found...Customer Number and Paper must both be in row 1"
    Application.ScreenUpdating = True
 
    End Sub