Use criteria to add colour to rows (Up to 6)

VBA Noob · Apr 25th 2006

Hi,

I'm looking to add colour to a row selection when a certain criteria is met. There is more than three criteria so the below Conditional formatting won't work on the test table also attached.

Order customer source £
4 bill a 6
4 bill d 5
5 bill a 7
5 bill b 4
5 bill c 3

Code

Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF($C1=""a"",TRUE,FALSE)"
Selection.FormatConditions(1).Interior.ColorIndex = 36
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF($C1=""b"",TRUE,FALSE)"
Selection.FormatConditions(2).Interior.ColorIndex = 35
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF($C1=""f"",TRUE,FALSE)"
Selection.FormatConditions(3).Interior.ColorIndex = 40

So I've tried using a If and Do statement but I'm having trouble with it. Can anyone point me in the right direction

Code

Range("C2").Select
Application.ScreenUpdating = False


Do


If ActiveCell = "a" Then Call SelectActiveRow
With Selection
.ColorIndex = 36
End With
End If
If ActiveCell = "b" Then Call SelectActiveRow
End
With Selection
.ColorIndex = 35
End With
End If
If ActiveCell = "c" Then Call SelectActiveRow
With Selection
.ColorIndex = 34
End With
End If
If ActiveCell = "d" Then Call SelectActiveRow
With Selection
.ColorIndex = 37
End With
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Loop Until IsEmpty(ActiveCell.Offset(0, 1))


Application.ScreenUpdating = True


End Sub

Display More

Code

Sub SelectActiveRow()
If IsEmpty(ActiveCell) Then Exit Sub
' ignore error if activecell is in Column A
On Error Resume Next
If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCell Else Set LeftCell = ActiveCell.End(xlToLeft)
If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCell Else Set RightCell = ActiveCell.End(xlToRight)
Range(LeftCell, RightCell).Select
End Sub

Thanks in advance

VBA Noob

**norie** · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

How is the code not working?

Can you explain in words the conditions you want to apply?

Code

Dim lColor As Long


Range("C2").Select
Application.ScreenUpdating = False
 
Do
    Select Case ActiveCell.Value
        Case "a"
            lColor = 36
        Case "b"
            lColor = 35
        Case "c"
            lColor = 34
        Case "d"
            lColor = 37
    End Select


    ActiveCell.EntireRow.ColorIndex = lColor
    ActiveCell.Offset(1, 0).Select
    
Loop Until IsEmpty(ActiveCell.Offset(0, 1))
 
Application.ScreenUpdating = True

Display More

Anonymous · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

norie has already posted an almost identical solution, but coded differently. I'll post this code just to show the variety.

Note that we both colored only occupied cells. Coloring/formatting an entire row creates a lot of overhead in a workbook and will case its size to grow quickly. It's generally a good rule to format only what needs to be formatted.

Code

Sub FillColors()
Dim c As Range
For Each c In Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    Select Case c
    Case "a"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 36
    Case "b"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 35
    Case "c"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 34
    Case "d"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 37
    Case "e"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 27
    Case "f"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 40
    Case "g"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 24
    Case "h"
        Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 46
    End Select
Next c
End Sub

Display More

**norie** · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

Tom

My code colours the EntireRow.:)

I couldn't quite work out what the OP's other procedure was trying to select for the formatting.

Anonymous · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

Oops, Sorry, norie. I didn't look closely enough. My quick reaction was your "loop until an empty cell is found" was going across the row, rather than checking the next row for an entry.

Humbled again. At least I'm consistent. :confused:

**norie** · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

Tom

I didn't bother doing anything with the ActiveCell stuff, though of course we all know there's no need for selecting.:)

Must be getting lazy.

VBA Noob · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

Hi Norie,

I'm got a spreadsheet which has colors e.g Green for Budget, Yellow for P. yr etc which I then put into a pivot table but when you interrogate the pivot the color doesn't come through went it opens a new page. So to make it easier for the end user I want to add a macro to look at column C and change each rows content color depending on the criteria in C2, C3 etc looping throught to the end.

Tried your code but gives a run time error

Code

ActiveCell.EntireRow.ColorIndex = lColor

Hope this explains it

VBA Noob · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

Thanks Norie,

That seems to have done the trick

Danny

VBA Noob · Apr 25th 2006

Re: Use criteria to add colour to rows (Up to 6)

Sorry,

Thanks to you to Tom

Danny

Use criteria to add colour to rows (Up to 6)

Participate now!

Share