Using VBA to select a row and colour code it based on conditions

[Toonster]

Hi,

I've had a look through the forum and can't see an answer, so apologies if I'm duplicating something!

I have a spreadsheet where column O has five conditions:
1 PO in
2 High Probability
3 Medium Probability
4 Low Probability
Blank

I need to colour code the whole row based on the value in the cells; if there were four conditions, I could do this with conditional formatting, but with five (with white as the fifth condition), I need to look at VBA.

However, I'm having difficulty colouring the whole row; how do I do this?

e.g. what I need to do is:
If O2 = "1 PO in"; Select A2:T2; Colour green

In addition, I need to ensure that if there is no data in column D, but column O is "1 PO in", it is highlighted in a separate colour. I have a macro for that, but don't know whether in needs to be put into the code before or after the macro needed above...

Many thanks in advance for your help!

 

[shyrath]

A simplified version would be:

Sub color()

    If Range("O2") = "1 PO in" Then


        If Range("D2") = "" Then
        Range("A2:T2").Interior.ColorIndex = 3 'red
    
        Else
    
       
            Range("A2:T2").Interior.ColorIndex = 4 'green
           
            
            End If
        
        
        End If
    
    
    
End Sub

 

[Toonster]

Many thanks

However, how do I do this so that it isn't a specific row number? i.e. when I change O3; O4; O20 etc?

Also, I think I didn't make myself clear. If there is no value in the D cell when the O cell is "1 PO in", just the D cell needs to be red; the rest of the row needs to be green. When data then gets put into the D cell (which can be numbers or text), the cell needs to then go back to being green.

Cheers!
Jo

 

[shyrath]

hi,

try something more like this

Loop will continue as long as there is data in column O

Sub color()

i = 2 'start row number


For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)

    If Cells(i, 15) = "1 PO in" Then

        rng = "A" & i & ":" & "T" & i
        Range(rng).Interior.ColorIndex = 4 'green
        
        If Cells(i, 4) = "" Then
        Cells(i, 4).Interior.ColorIndex = 3 'red

        
    
        Else
                 
        End If
        
    End If
    i = i + 1
    
    Next c
    
    
End Sub

 

[Toonster]

Fantastic!!
That works brilliantly - thank you so much

 

[Toonster]

Eeep - I've just tried to do this with the multiple variables needed...

It's now:

i = 2 'start row number
For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)
    If Cells(i, 15) = "1 In" Then
        rng = "A" & i & ":" & "T" & i
        Range(rng).Interior.ColorIndex = 4 'green
        If Cells(i, 4) = "" Then
        Cells(i, 4).Interior.ColorIndex = 3 'red
        Else
        End If
    End If
    i = i + 1
    i = 2 'start row number
For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)
    If Cells(i, 15) = "2 High" Then
        rng = "A" & i & ":" & "T" & i
        Range(rng).Interior.ColorIndex = 44 '[Color 44]
    End If
    i = i + 1
    i = 2 'start row number
    For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)
    If Cells(i, 15) = "3 Medium" Then
        rng = "A" & i & ":" & "T" & i
        Range(rng).Interior.ColorIndex = 46 '[Color 46]
    End If
    i = i + 1
    i = 2 'start row number
        For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)
    If Cells(i, 15) = "4 Low" Then
        rng = "A" & i & ":" & "T" & i
        Range(rng).Interior.ColorIndex = 3 'red
    End If
    i = i + 1
    Next c
    Application.EnableEvents = True
End Sub

However, when I try to run this, I get:
Compile Error:
For Control Variable already in use.

(The reason for not having the

Sub color ()

is that I already have coding for a time macro in there; if I try to have this as a separate sub, then it doesn't work at all...)

Where is it going wrong?

 

[shyrath]

You only use the FOR once. This kicks off the loop.

So:

For each row in column O do this.

i = 2 is the starting row

then at the end you get

i = i +1 so we are now on row 3 and with Next c we do the "for each" loop again untill we are out of rows to check.


So in your code below remove all but the last of the i = i + 1
and all but the first of the
For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)

 

[Toonster]

Absolutely brilliant!

Thank you very much (this VBA stuff is starting to make a bit more sense... )

 

[Toonster]

Me again

I'm using the codes given above to create the following macro (part of a larger set of macros in the spreadsheet)

i = 2 'start row number
For Each c In ActiveSheet.Range("Q2:Q" & Range("Q" & Rows.Count).End(xlUp).Row)
    
    'If Column Q is "1 In", then colour the row green.  If there is no data in
    'the PO in cell in Column E, colour that cell red, otherwise leave it green.
    If Cells(i, 17) = "1 In" Then
        rng = "A" & i & ":" & "V" & i
        Range(rng).Interior.ColorIndex = 4 'green
        If Cells(i, 5) = "" Then
        Cells(i, 5).Interior.ColorIndex = 3 'red
        Else
        End If
    End If
    
    'If Column Q is "2 High", then colour the row yellow.
    If Cells(i, 17) = "2 High" Then
        rng = "A" & i & ":" & "v" & i
        Range(rng).Interior.ColorIndex = 44
    End If
    
    'If Column Q is "3 Medium" then colour the row orange.
        If Cells(i, 17) = "3 Medium" Then
        rng = "A" & i & ":" & "V" & i
        Range(rng).Interior.ColorIndex = 46
    End If
    
    'If Column Q is "4 Low" then colour the row red.
        If Cells(i, 17) = "4 Low" Then
        rng = "A" & i & ":" & "U" & i
        Range(rng).Interior.ColorIndex = 3 'red
    End If
    
    'If there is no data in Column Q then remove colour from the row.
    If Cells(i, 17) = "" Then
        rng = "A" & i & ":" & "V" & i
        Range(rng).Interior.ColorIndex = xlNone
    End If
    
i = i + 1
    Next c
    Application.EnableEvents = True
End Sub

However, what is happening on this is that if data is taken out of Column Q (i.e. if the value is deleted), then the macro won't clear it until something is added to Column Q below where the data was taken out (i.e. if I take the data out of Q6, it won't remove the colour until I add data to Q7.

The only rows it does it correctly in are rows 2 and 3.

Is there any way of changing this so that it will take it out automatically? It works fine for the colouring.

 

[mikerickson]

I think this Change event might do what you want. It uses the Select Case construction. I goes in the sheets code module.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim keyRange As Range, oneCell As Range
    
    On Error Resume Next
        Set keyRange = Target
        Set keyRange = Application.Union(Target, Target.Dependents)
    On Error GoTo 0
    
    For Each oneCell In Application.Intersect(keyRange, Range("E:E, Q:Q"))
    
        With oneCell.EntireRow.Range("A1:V1").Interior
            Rem test value from column Q
            Select Case CStr(oneCell.EntireRow.Range("Q1").Value)
                Case Is = "1 In"
                    If oneCell.EntireRow.Range("E1") = "" Then
                        .ColorIndex = 3
                    Else
                        .ColorIndex = 4
                    End If
                Case Is = "2 High"
                    .ColorIndex = 44
                Case Is = "3 Medium"
                    .ColorIndex = 46
                Case Is = "4 Low"
                    .ColorIndex = 3
                Case Else
                    .ColorIndex = xlNone
            End Select
        End With
        
    Next oneCell
End Sub