Conditional formatting with 255 colours

[GeorgeF211]

Hi All,


I recently came to the conclusion that my spreadsheets just aren't colourful enough. To that end, I decided to bodge out some VBA code to give me a full range of cell shading from RGB(1,255,1) to RGB(255,1,1) - increasing red by one each iteration and decreasing green by one. Perhaps unsurprisingly, this has crashed excel. Does anyone know of a more efficient way of giving myself a good gradient of colours, or should I just stick to some of the more basic 5 to 10 colour options with set conditions.

[pre]

Private Sub Worksheet_Change(ByVal Target As Range)
Set ranger = Range("E1:E100")
Dim Red As Integer 'Red component of colour
Dim Green As Integer 'green component of colour
Dim Blue As Integer 'blue component of colour
Red = 1
Green = 255
Blue = 1 'we're not using this right now, but it might come in handy later
'these three statements set the colour to pure green

For Each cell In ranger 'run for the entire range
If Not IsError(cell.Value) And IsNumeric(cell.Value) Then 'only work on non-error numeric cells
Do Until Red = 255 And Green = 1  'keep running until we are at pure red
If cell.Value > Cells(ActiveCell.Row, 3) * Red / 255 Then
'Put whatever we're going to be doing with the colours here

cell.Interior = RGB(Red, Green, Blue)

If Green > 1 Then 'Roll the green back until it hits one
Green = Green - 1
End If

If Red < 255 Then 'move up through the red values until it hits 255
Red = Red + 1
End If
'I've kept these seperate as it allows you to set different starting points - also prevents errors
End If
Loop
End If
Next
End Sub

[/pre]

Any help would be greatly appreciated,


Cheers

 

[NARAYANK991]

Hi George ,


I cannot comment on why Excel crashed while running your code. However , I have a few doubts on what it is supposed to be doing :


1. Your Do ... Until loop checks for Red = 255 and Green = 1. Once the program exits from this loop , it will not execute this loop for any other cell in the range E1:E100 , since Red and Green will retain their values. Shouldn't you be initializing Red , Green and Blue just before the Do ... Until loop , instead of outside the For ... Next loop ?


2. Your CF range is E1:E100 ; however , the statement :


If cell.Value > Cells(ActiveCell.Row, 3) * Red / 255 Then


is looking at column 3 ; is this a typo ?


3. What is the purpose of the above IF statement ? If you just want a gradient of CF , why check for the cell value ?


Narayan

 

[GeorgeF211]

Unfortunately most of the creation of this is based on guesswork and half remembered coding, plus possibly misunderstood dissected macros.


1. Yes, it should reset, my bad;


2. & 3. I think I probably need to define another range - I'm trying to say

if the value of the active cell is more than n / 255 times the value in column C, then do the stuff below

 

[NARAYANK991]

Hi George ,


Try this and see if it does something :

[pre]

Private Sub Worksheet_Change(ByVal Target As Range)
Set ranger = Range("E1:E100")
Dim Red As Integer 'Red component of colour
Dim Green As Integer 'green component of colour
Dim Blue As Integer 'blue component of colour
For Each cell In ranger 'run for the entire range
If Not IsError(cell.Value) And IsNumeric(cell.Value) Then 'only work on non-error numeric cells
Red = 1
Green = 255
Blue = 1
Do Until Red = 255 And Green = 1  'keep running until we are at pure red
If cell.Value > Cells(ActiveCell.Row, 3) * Red / 255 Then
'Put whatever we're going to be doing with the colours here
cell.Interior.Color = RGB(Red, Green, Blue)
End If
If Green > 1 Then 'Roll the green back until it hits one
Green = Green - 1
End If

If Red < 255 Then 'move up through the red values until it hits 255
Red = Red + 1
End If
Loop
End If
Next
End Sub

[/pre]
Narayan

 

[GeorgeF211]

Thanks Narayan,


Unfortunately I think my work computer may just be a little inadequate, so I'll have a play at home and see if this works.

 

[Hui]

Hi George


If you are comparing the cells in Column E against the entire Range C1:C100

and coloring accordingly teh following should do the trick

[pre]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Red As Integer 'Red component of colour
Dim Green As Integer 'green component of colour
Dim Blue As Integer 'blue component of colour
Dim Max as Double, Min as Double

Set Ranger = Range("E1:E100")
Blue = 1
Max = Application.WorksheetFunction.Max(Ranger.Offset(, -2))
Min = Application.WorksheetFunction.Min(Ranger.Offset(, -2))

For Each cell In Ranger 'run for the entire range
If Not IsError(cell.Value) And IsNumeric(cell.Value) Then 'only work on non-error numeric cells
Red = Int(255 * (cell.Value - Min) / (Max - Min))
Green = 255 - Int(255 * (cell.Value - Min) / (Max - Min))
'Debug.Print cell.Value, Red, Green 'This row can be deleted
cell.Interior.Color = RGB(Red, Green, Blue)
End If
Next

End Sub

[/pre]

ps: I shamelessly plagiarized Narayan's code for this, Thanx Narayan


pps: This isn't PC breaking code and should easily run on any old pc

 

[NARAYANK991]

Hi Hui ,


No problem , I pinched George's !


Narayan