Help again: Code for Conditional Format with more than 3 con

[sdeppe]

Hi There,
Thanks for the reply, I found another makro doing conditional format with more than 3 conditions...BUT it does not work. Where in the code do I have to insert the desired range?

Here is the code (found at http://www.geocities.com/davemcritchie/excel/colors.htm):


Sub ColorRowBasedOnCellValue()
'David McRitchie, 2001-01-17 programming -- Color row based on value
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
For Each cell In Intersect(Selection, ActiveCell.EntireColumn, _
ActiveSheet.UsedRange
Select Case cell.Value
Case Is >= 50
cell.EntireRow.Interior.colorindex = 20
Case Is >= 40
cell.EntireRow.Interior.colorindex = 37
Case Is >= 20
cell.EntireRow.Interior.colorindex = 38
Case Is >= 0
cell.EntireRow.Interior.colorindex = 36
Case Else
cell.EntireRow.Interior.colorindex = 44
End Select
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub

 

[XL-Dennis]

sdeppe,

Welcome to the board

Following code will check each cells value and colour the whole row depending on the values.

You can easily change cellrange.

<PRE>
<FONT color=blue>Sub </FONT>ColorRowBasedOnCellValue()

<FONT color=#ff0000>'David McRitchie, 2001-01-17 programming -- Color row based on value
</FONT>
Application.ScreenUpdating =<FONT color=blue> False</FONT>

Application.Calculation = xlCalculationManual

<FONT color=blue>Dim </FONT>cell<FONT color=blue> As</FONT> Range, rnArea<FONT color=blue> As</FONT> Range



<FONT color=blue>Set </FONT>rnArea = ActiveSheet.Range("A1:A20")



<FONT color=blue>For </FONT>Each cell In rnArea

Select <FONT color=blue>Case </FONT>cell.Value

<FONT color=blue>Case </FONT>Is >= 50

cell.EntireRow.Interior.ColorIndex = 20

<FONT color=blue>Case </FONT>Is >= 40

cell.EntireRow.Interior.ColorIndex = 37

<FONT color=blue>Case </FONT>Is >= 20

cell.EntireRow.Interior.ColorIndex = 38

<FONT color=blue>Case </FONT>Is >= 0

cell.EntireRow.Interior.ColorIndex = 36

<FONT color=blue>Case </FONT><FONT color=blue>Else</FONT>

cell.EntireRow.Interior.ColorIndex = 44

<FONT color=blue>End Select</FONT>

<FONT color=blue>Next </FONT>cell

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating =<FONT color=blue> False</FONT>

<FONT color=blue>End Sub</FONT>




</PRE>

HTH,
Dennis

 

[sdeppe]

Hi Dennis,

thank you VERY MUCH for your help on this. Meanwhile, after hours spent cursing and throwing paper out of the window I got it working somehow.

I first tried event makros, but I gave up. Now I have a neat button with the code below.

If I wanted to do the macro for several columns I would have to repeat the respective lines, for each column with different cell names?

Thanks a lot

Sebastian


Sub ColorCellBasedOnCellValue()
'Sebastian Deppe -- Color based on value
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
For Each cell In ActiveSheet.Range("a1:a10")
Select Case cell.Value
Case Is <= Range("A12")
cell.Interior.ColorIndex = 37
Case Is <= Range("A13")
cell.Interior.ColorIndex = 32
Case Is <= Range("A15")
cell.Interior.ColorIndex = 31
Case Is <= Range("A16")
cell.Interior.ColorIndex = 30
Case Else
cell.Interior.ColorIndex = 36
End Select
Next cell
End Sub

 

[XL-Dennis]

Sebastian,

If I wanted to do the macro for several columns I would have to repeat the respective lines, for each column with different cell names?

there exist several differens approaches to this depending on the specific situation.

Could You kindly provide more information?
Do You mean that You have several columns in the same rows, 1:10 or several columns with different ranges?

Kind regards,
Dennis

 

[sdeppe]

Hi Dennis,

I meant adding more columns for the same lines. The task is to evaluate 50 companies (down the table) over 15 yrs (across the table)after different criteria (sheets). For each year, there is a different average for the 50 firms and the deviation from that average is coloured by my macro. Green for the top 20%, dark red for the bottom ones and so on.

What I did: I copied the whole code for each column (year) and replaced the cell names each time. Well, I end up with hundreds of code lines..

BUT IT WORKS for the time being.

THANKS AGAIN.

Sebastian

 

[XL-Dennis]

Sebastian,

Glad it worked out although it sounds like hard work.

If You intend to alter / update You code or for future reference You might use

<pre>
Dim rnArea As Range

With ActiveSheet
Set rnArea = .Range(.Range("A1"), .Range("O65536").End(xlUp))
End With

For Each rnCell In rnArea
'....
Next rnCell
</prev>

Kind regards,
Dennis