Setting RGB colors for a set of cells.

[Miron]

Hi
Iv got a huge problem with setting RGB colors in excel for difrent
cells
take a look on my script:

Sub ColorCellBasedOnCellValue()

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 = False
cell.Interior.ColorIndex = 0
Case Else
cell.Interior.color = RGB(CByte("&H" & Right$(cell.Value,
2)), CByte("&H" & Mid$(cell.Value, 3, 2)), CByte("&H" & Left$
(cell.Value, 2)))

End Select
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub

It supose to change Hexadecimal code from a cell change it to RGB and
than fill its background with that color. It works, except excel uses
its 56 color palette and puts own closest colors.
I was thinking to change that formula to create a separate palette for
each one color or new palete for every 56 new colors than create new
one until finish (thers 800 difrend codes that i have to change). The
problem is that i dont know how to do it. Can anybody help me with
this??

 

[Guest]

hi
see this site...

http://support.microsoft.com/default.aspx/kb/140848

regards
FSt1

 

[Peter T]

As you've found out the palette is limited to 56 colours, attempting to
apply an RGB will match to the closest in the palette. You can of course
customize any or all the palette colours to your own needs,

Active.workbook.Colors(n) = RGB(r,g,b) where n is 1 to 56

I don't follow what you mean by your 800 different codes to change. If that
means you have 800 RGB's, several of which are duplicates and 56 or less are
unique, customize the palette with the unique colours.

However if, in effect, you want 800 different colours in cells, these can
be simulated with the pattern greys 25, 50 & 75%. However to find the right
combinations of patterns and colours that most closely match your required
RGB's is a lot of work. I'm not aware of anything freely available to do
that, commercially perhaps soon.

The other approach of course, assuming you only want the colours in cells
without cell contents, is to use shapes. These can be formatted with any
colour and sized to cells, or even textboxes with text linked to cells
underneath. Then of course you might need to automatically adjust the font
colour to contrast, but that's another subject.

Failing all the above as solutions you might look at Excel 2007.

Regards,
Peter T

 

[Miron]

Hy there, thx for your quick replying!!I
Although I've change my script a little bit so its almost works
properly... Just try it, put some hexadecimal codes #xxxxxx in a
column, select it and run my formula ( try changing a little bit just
one color to make a gradient, like:

#332222
#332232
#332242
#332252
#332262

(for Peter T - it looks like thise but column has 800 cells with
diffrent codes :/)

and u'll see its working:

Sub ColorCellBasedOnCellValue3()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim strHexColor As String
'Dim HexColor As String
Dim i As Byte
Dim cell As Range
i = 17
For Each cell In Intersect(Selection, ActiveCell.EntireColumn, _
ActiveSheet.UsedRange)
strHexColor = Right((cell.Value), 6)
'For i = 1 To (6 - Len(strHexColor))
'HexColor = HexColor & "0"
' Next
' HexColor = HexColor & strHexColor
Select Case cell.Value
Case Is = False
cell.Interior.ColorIndex = 0
Case Else
ActiveWorkbook.Colors(i) = RGB(CByte("&H" & Right$
(strHexColor, 2)), CByte("&H" & Mid$(strHexColor, 3, 2)), CByte("&H" &
Left$(strHexColor, 2)))
cell.Interior.ColorIndex = i
i = i + 1
End Select
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub


"i" starts from 1 and gets to 56. If there is more than 56 colors its
crashing :/
so.....
I just need a bit of script to change/add new palette of colors after
"i" reaching 56, and some fancy way to put it to my script. I'm still
looking, but I will really appreciate your help...

Cheers
Miroon

 

[Guest]

hi,
in xl help, type the word specifications.
the number of colors in excel is limited to 56. no more.
sorry
Regards
FSt1

 

[Peter T]

As both FSt1 and I have tried to point out, the workbook's palette is
limited to 56 colours. You can't have two palettes running at the same time
in the same workbook (actually it is possible with two windows).

I don't want to put you off as, despite the 56 colour limitation, Excel has
extremely good capabilities for working with colours, perhaps even because
of the limited palette.

What you could do is define a number of palettes in rows of 56 cells, you
can load a new palette very quickly like this.

vPal = ActiveSheet.Range("A1:BD1")
ActiveWorkbook.Colors = vPal

(or store in columns and transpose)

The colour numbers need to be stored in the Long format -
=red+(green*256)+(blue*256^2)

Of course any palette colours used in formats in the entire workbook will
change.

Another thing that's possible is to activate a new palette in the sheet
activate event. That works well for changing colour schemes with same
formats on different sheets.

In passing, the method you are using to change just one of the RGB
attributes does not always correctly give a monotone gradient, your example
shifts the colour tone (Hue), though not noticeable with those dark colours.

Regards,
Peter T


Hy there, thx for your quick replying!!I
Although I've change my script a little bit so its almost works
properly... Just try it, put some hexadecimal codes #xxxxxx in a
column, select it and run my formula ( try changing a little bit just
one color to make a gradient, like:

#332222
#332232
#332242
#332252
#332262

(for Peter T - it looks like thise but column has 800 cells with
diffrent codes :/)

and u'll see its working:

Sub ColorCellBasedOnCellValue3()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim strHexColor As String
'Dim HexColor As String
Dim i As Byte
Dim cell As Range
i = 17
For Each cell In Intersect(Selection, ActiveCell.EntireColumn, _
ActiveSheet.UsedRange)
strHexColor = Right((cell.Value), 6)
'For i = 1 To (6 - Len(strHexColor))
'HexColor = HexColor & "0"
' Next
' HexColor = HexColor & strHexColor
Select Case cell.Value
Case Is = False
cell.Interior.ColorIndex = 0
Case Else
ActiveWorkbook.Colors(i) = RGB(CByte("&H" & Right$
(strHexColor, 2)), CByte("&H" & Mid$(strHexColor, 3, 2)), CByte("&H" &
Left$(strHexColor, 2)))
cell.Interior.ColorIndex = i
i = i + 1
End Select
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub


"i" starts from 1 and gets to 56. If there is more than 56 colors its
crashing :/
so.....
I just need a bit of script to change/add new palette of colors after
"i" reaching 56, and some fancy way to put it to my script. I'm still
looking, but I will really appreciate your help...

Cheers
Miroon