Traffic Light macro

[macdca]

I have a waiting list that I want to colour usig a macro, based on certain criteria.

What I have already is:


PatientOffset = 0

Do

Wait = Range("H2").Offset(PatientOffset, 0).Value
If Wait > 31 Then
Range("H2").Offset(PatientOffset, 0).EntireRow.Interior.ColorIndex = 3 ' RED
ElseIf Wait > 25 Then
Range("H2").Offset(PatientOffset, 0).EntireRow.Interior.ColorIndex = 46 ' AMBER
ElseIf Wait > 0 Then
Range("H2").Offset(PatientOffset, 0).EntireRow.Interior.ColorIndex = 43 ' GREEN
ElseIf Wait = " " Then
Range("H2").Offset(PatientOffset, 0).EntireRow.Interior.ColorIndex = 2 ' WHITE
ElseIf Wait Is Null Then
Range("H2").Offset(PatientOffset, 0).EntireRow.Interior.ColorIndex = 2 ' WHITE
End If


PatientOffset = PatientOffset + 1

Loop Until Range("H2").Offset(PatientOffset, 0).Value = ""

This isnt doing exaclty what I would like. Im ot sure what the offset fuction does.

I want to colour affecting rows where i column H the value is over 31 days when column K has the text beginnig with yes*(wildcard) or is blank or unkn* (wildcard)

If its over 31 days ad the text is No* (wildcard), leave white

If H is between 25 and 31, and yes*(wildcard) or blank or unkn* (wildcard) colour rows amber, if No* leave white

If between 0 and 25 and yes*(wildcard) or blank or unkn* (wildcard) colour green, if No in H, leave white

I want it to loop dow to the last record rather then the first blank, s soe are blank.

Can anyone tweak m macro? Thanks

 

[Misca]

Maybe something like this:

Dim c As Range
Dim i As Integer    'Color index
Dim KTxt As String
Dim Yes As String
Dim Unkn As String
For Each c In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    With c
        i = 2   'White is the default color
        KTxt = UCase(.Offset(0, 3).Value)   'Column K value in upper case
            
            If Left(KTxt, 2) <> "NO" Then
                       
                If KTxt = "" Or Left(KTxt, 3) = "YES" Or Left(KTxt, 4) = "UNKN" Then
                       
                    Select Case Val(.Value)
                        Case Is < 25
                                i = 43 'Green
                        Case 25 To 31
                                i = 46  'Amber
                        Case Is > 31
                                i = 3   'Red
                    End Select
                End If
            End If
        .EntireRow.Interior.ColorIndex = i
    End With
Next c

 

[macdca]

Thank you for that, thats great, almost there. I would also like the macro to colour if its blank as well as yes, it doesnt seem to do that?

Also, the rows at the end that have no value in column H are not colouring? similarly where there is no valus but the character: -, I would like these included i the yes, or blank (or -) or unknown?

 

[macdca]

One other thing, how can I reset the cells to white before the colour macro runs as it seems to hold old formatting for a number of rows at the end?

 

[macdca]

Selection.Interior.ColorIndex = xlNone
Dim i As Integer 'Color index
Dim MTxt As String
Dim Yes As String
Dim Unkn As String


For Each c In Range("J2:J" & Range("J" & Rows.Count).End(xlUp).Row)
With c
i = 2 'White is the default color
MTxt = UCase(.Offset(0, 3).Value) 'Column M value in upper case

If Left(MTxt, 2) <> "NO" Then


If MTxt = "" Or Left(MTxt, 3) = "YES" Or Left(MTxt, 4) = "UNKN" Or Left(MTxt, 2) = " " Then


Select Case Val(.Value)
Case Is < 15
i = 43 'Green
Case 15 To 31
i = 46 'Amber
Case Is > 31
i = 3 'Red
End Select
End If
End If

.EntireRow.Interior.ColorIndex = i
End With
Next c


The macro above works great for colouring my rows, thanks again. I would like to make a couple of exclusions. Where the text in column M starts with YES, and it colours those rows depending on the value in column J, I would like this NOT to happen if in column D appears the text 'New Start IMRT', 'New Start SBRT', 'New Start RapidArc' or 'New Start CHART'

Can you help me with this?

Thanks

 

[macdca]

Sorry, i forgot to add - Rather than the rows be red, I would like the text to be red instead?

 

[Misca]

Dim i As Integer 'Color index
Dim x As Integer
Dim MTxt As String
Dim Yes As String
Dim Unkn As String
Dim Def As Integer  'Default color

For Each c In Range("J2:J" & Range("J" & Rows.Count).End(xlUp).Row)
    With c
    
        Def = 1 'Default color: 1=Black, 2=White
        i = Def
        
        MTxt = UCase(.Offset(0, 3).Value) 'Column M value in upper case
        
        If Left(MTxt, 2) <> "NO" Then
        
            If MTxt = "" Or Left(MTxt, 3) = "YES" Or Left(MTxt, 4) = "UNKN" Or Left(MTxt, 2) = " " Then
            
                Select Case Val(.Value)
                    Case Is < 15
                        i = 43 'Green
                    Case 15 To 31
                        i = 46 'Amber
                    Case Is > 31
                        i = 3 'Red
                End Select
            
                With .Offset(0, -6) 'Checks the value in column D:
                    For x = 1 To 3  'if any of the 3 values is found:
                        If InStr(.Value, Choose(x, "New Start IMRT", "New Start SBRT", "New Start CHART")) > 0 Then
                            i = Def   'Back to default
                        End If
                    Next x
                End With
            End If
        End If
        
       ' .EntireRow.Interior.ColorIndex = i  'Cell interior color
        .EntireRow.Font.ColorIndex = i  'Font color
    End With
Next c

 

[macdca]

Hi, thanks for your reply. That isnt quite what I was looking for. I am happy with the original the way it is in terms of the colours and the fact it colours the cell rather than the font. The change I would like is for those rows that have the text I specified, rather than them being shaded (if they meet the shading criteria), I wuold like the shading to be slightly different for those in order to identify them as different. So either the shading have a pattern in the background maybe? (that can still easily read) or the text be coloured rather thn the cell in those istances only where the text is there?