Excel VBA conditional formatting

[Chattin]

Hello all.

I'm trying to create a macro to conditionally format a range of cells depending on a set of criteria in the worksheet. The set up of the sheet is as follows and there are more than 3 criteria

A B C .... AH
1 Primary
2 Secondary
3 Tertiary
4 Secondary

Column AH contains the criteria such that e.g. if AH1="Primary" then range A1:E1 cell's colour will be red and make the font white and if cell AH1 = "Secondary" then colour cells range A1:E1 yellow and make the font black THEN if e.g. AH2="Primary" then range A2:E2 will have the criteria applied etc...

I've come up with this code so far but I need to implement a looping structure to go through the whole range and I'm a bit stuck - any ideas? (The line Set criteria = ActiveCell.Offset(rowOffset:=0, columnOffset:=33).Value doesn't work btw but its work in progress)

Sub Condform()
Worksheets("Sheet1&quot.Activate
Worksheets("Sheet1&quot.Range("A1&quot.Select
Dim icolor As Integer
Dim fcolor As Integer
Dim criteria As Range
Dim Target As Range
Set Target = Worksheets("Sheet1&quot.Range("A1:G155&quot
Set criteria = ActiveCell.Offset(rowOffset:=0, columnOffset:=33).Value
Select Case criteria
Case "Primary"
icolor = 3
fcolor = 2
Case "Secondary"
icolor = 6
fcolor = 1
End Select
Target.Interior.ColorIndex = icolor
Target.Font.ColorIndex = fcolor
End Sub

Hopefully I've explained well enough

 

[Bowers74]

A slight change to your code will give you a loop:

Sub Condform()
' Worksheets("Sheet1").Activate ' You don't need this
' Worksheets("Sheet1").Range("A1").Select ' You don't need this
Dim icolor As Integer, fcolor As Integer
Dim criteria As Range, Target As Range, c as range
Set Target = Worksheets("Sheet1").Range("A1:G155")
for each c in target
    Set criteria = c.Offset(0, 33).Value
    Select Case criteria
        Case "Primary"
            icolor = 3
            fcolor = 2
        Case "Secondary"
            icolor = 6
            fcolor = 1
    End Select
    c.Interior.ColorIndex = icolor
    c.Font.ColorIndex = fcolor
next c
End Sub

View my FAQ faq707-4090

And SkipVought's FAQ faq707-4105

To help you optimize your code more!

Good Luck!



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[Chattin]

Thanx for your reply

I'm getting a 424 - Object required error

any ideas?

TIA

 

[Bowers74]

Ooops,

Sorry!

Change for each c in target

to for each c in target.cells

That should do it!



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[Chattin]

Thanks again!