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

sdeppe

New Member
Joined
Aug 27, 2002
Messages
4
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
sdeppe,

Welcome to the board :smile:

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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,229
Messages
6,170,880
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top