color a cell based on 2 conditions

[StartingOut]

Hi, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I have a worksheet with several columns and 500 rows, I need a VBA script or formula that will check one of 3 conditions<o></o>
<o></o>
the cells are B3 H3 N3 the key cell is N3<o></o>
<o></o>
1- if N3 contains the word ball then check the conditions of B3 and H3 and proceed to set 2 and 3. if not, then do nothing<o></o>
<o></o>
2- If N3 contains the word "ball" and B3 contains "P1" and H3 is "=<2:00:00" then set H3 cell fill color to green; but if H3 is >2:00:00 set H3 fill color to Red<o></o>
<o></o>
3- If N3 contains the word "ball" and B3 contains "P2" and H3 is "=<6:00:00" then set H3 cell fill color to green; but if H3 is >6:00:00 set H3 fill color to Red

 

[John Davis]

Hi, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I have a worksheet with several columns and 500 rows, I need a VBA script or formula that will check one of 3 conditions<o></o>
<o></o>
the cells are B3 H3 N3 the key cell is N3<o></o>
<o></o>
1- if N3 contains the word ball then check the conditions of B3 and H3 and proceed to set 2 and 3. if not, then do nothing<o></o>
<o></o>
2- If N3 contains the word "ball" and B3 contains "P1" and H3 is "=<2:00:00" then set H3 cell fill color to green; but if H3 is >2:00:00 set H3 fill color to Red<o></o>
<o></o>
3- If N3 contains the word "ball" and B3 contains "P2" and H3 is "=<6:00:00" then set H3 cell fill color to green; but if H3 is >6:00:00 set H3 fill color to Red

Does this work?

Sub StartingOut()

If Range("N3").Value = "ball" Then

    Select Case Range("B3").Value
    
    Case Is = "P1"

        Select Case Range("H3").Value
        
        Case Is <= #2:00:00 AM#
        
                Range("H3").Interior.ColorIndex = 4
                
        Case Is > #2:00:00 AM#
        
                Range("H3").Interior.ColorIndex = 3
                
        End Select
        
    Case Is = "P2"
    
        Select Case Range("H3").Value
        
        Case Is <= #6:00:00 AM#
        
                Range("H3").Interior.ColorIndex = 4
                
        Case Is > #6:00:00 AM#
        
                Range("H3").Interior.ColorIndex = 3
                
        End Select

    End Select
        
End If

End Sub

 

[StartingOut]

Thats great, it does work.

but 2 things, I need it to check all the rows, right now it works only in row 3. also the time checking of <= 2:00:00 is not quite right when the time is 2:00:00 it should be green but it is coding it as red

 

[Jonmo1]

This can be done with conditional formatting...

Highlight H3
Click format - conditional formatting

Condition 1:
Select Formula Is
=AND(N3="ball",OR(AND(B3="P1",H3<="2:00:00"+0),AND(B3="P2",H3<="6:00:00"+0)))
Format for Green

Click Add
Condition 2:
Select Formula is
=AND(N3="ball",OR(AND(B3="P1",H3>"2:00:00"+0),AND(B3="P2",H3>"6:00:00"+0)))
Format for Red


Hope that helps.

 

[John Davis]

Thats great, it does work.

but 2 things, I need it to check all the rows, right now it works only in row 3. also the time checking of <= 2:00:00 is not quite right when the time is 2:00:00 it should be green but it is coding it as red

Try this change:

Sub StartingOut()

Dim i As Long

Dim lr As Long

lr = Cells(Rows.Count, 1).End(3).Row

For i = lr To 2 Step -1

If Range("N" & i).Value = "ball" Then

    Select Case Range("B" & i).Value
    
    Case Is = "P1"

        Select Case Range("H" & i).Value
        
        Case Is = #2:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 4

        Case Is < #2:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 4
            
        Case Is > #2:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 3
                
        End Select
        
    Case Is = "P2"
    
        Select Case Range("H" & i).Value
        
        Case Is <= #6:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 4
                
        Case Is > #6:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 3
                
        End Select

    End Select
        
End If

Next i

End Sub

 

[StartingOut]

Excelent!! with one last little thing, if for some reason when column N, that once read Ball and the cel in columb H was color filled, if column N Ball is changed to something else the color is not removed from the cell in column H when the code executes

 

[Jonmo1]

Change

End If

to

Else
    Range("H" & i).Interior.ColorIndex = xlNone
End If

Hope that helps.

 

[StartingOut]

well done!!! it all works like a charm, Thank You so much.

If you could indulge me just this one last time, lets say I wanted this code to ony execute from row 3 to row 1000 so that my header rows from 1 to 2 keep their color

 

[John Davis]

well done!!! it all works like a charm, Thank You so much.

If you could indulge me just this one last time, lets say I wanted this code to ony execute from row 3 to row 1000 so that my header rows from 1 to 2 keep their color

You're welcome. I hope this works.

Sub StartingOut()

Dim i As Long

Dim lr As Long

lr = Cells(Rows.Count, 1).End(3).Row

For i = lr To 3 Step -1

If Range("N" & i).Value = "ball" Then

    Select Case Range("B" & i).Value
    
    Case Is = "P1"

        Select Case Range("H" & i).Value
        
        Case Is = #2:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 4

        Case Is < #2:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 4
            
        Case Is > #2:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 3
                
        End Select
        
    Case Is = "P2"
    
        Select Case Range("H" & i).Value
        
        Case Is <= #6:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 4
                
        Case Is > #6:00:00 AM#
        
                Range("H" & i).Interior.ColorIndex = 3
                
        End Select

    End Select
        
Else

    Range("H" & i).Interior.ColorIndex = xlNone

End If

Next i

End Sub

 

[StartingOut]

perfect!! and again thank you