PDA

View Full Version : [SOLVED] Color format



u25103
09-09-2008, 01:58 AM
Hi
This is my problem...:think:
I a matrix (for example ("A1:C100") numbers 1001 to 1130 in a radom order.
Now I want to colorformat the cells that has a specific number. I've tried to do this in "Conditional Formatting" but as everybody knows, a can only use 3 conditions.
I want to color, for example the numbers 1002,1005,1015,1019,1024.

I hope there is someone out there who knows something about this.

Manny Thanks:think:

Bob Phillips
09-09-2008, 02:11 AM
Option Explicit

Public Enum xlColorIndex
xlCIBlack = 1
xlCIWhite = 2
xlCIRed = 3
xlCIBrightGreen = 4
xlCIBlue = 5
xlCIYellow = 6
xlCIPink = 7
xlCITurquoise = 8
xlCIDarkRed = 9
xlCIGreen = 10
xlCIDarkBlue = 11
xlCIDarkYellow = 12
xlCIViolet = 13
xlCITeal = 14
xlCIGray25 = 15
xlCIGray50 = 16
xlCIPeriwinkle = 17
xlCIPlum = 18 ' chart colours
xlCIIvory = 19 '
xlCILightTurquoiseChart = 20 '
xlCIDarkPurpleChart = 21 '
xlCICoralChart = 22 '
xlCIOceanBlueChart = 23 '
xlCIIceBlueChart = 24 '
xlCIDarkBlueChart = 25 '
xlCIPinkChart = 26 '
xlCIYellowChart = 27 '
xlCITurquoiseChart = 28 '
xlCIVioletChart = 29 '
xlCIDarkRedChart = 30 '
xlCITealChart = 31 '
xlCIBlueChart = 32
xlCISkyBlue = 33
xlCILightGreen = 35
xlCILightYellow = 36
xlCIPaleBlue = 37
xlCIRose = 38
xlCILavender = 39
xlCITan = 40
xlCILightBlue = 41
xlCIAqua = 42
xlCILime = 43
xlCIGold = 44
xlCILightOrange = 45
xlCIOrange = 46
xlCIBlueGray = 47
xlCIGray40 = 48
xlCIDarkTeal = 49
xlCISeaGreen = 50
xlCIDarkGreen = 51
xlCIBrown = 53
xlCIIndigo = 55
xlCIGray80 = 56
End Enum

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:C100" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Select Case .Value
Case 1002: .Interior.ColorIndex = xlCIRed
Case 1005: .Interior.ColorIndex = xlCIYellow
Case 1015: .Interior.ColorIndex = xlCIBlue
Case 1019: .Interior.ColorIndex = xlCIGgreen
'etc
End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

u25103
09-09-2008, 03:07 AM
Thank you
It works
but...
I already have the numbers in the matix and when I copy/paste the cod in it dosen't change the colors that allready is in the matrix, it only chenge colors when I reenter a number.
Can I change the cod in someway so it change the interior color on the already writed numbers?????

Many thanks

Bob Phillips
09-09-2008, 03:31 AM
Yes, select them all and just F2-Enter, it will trigger the code.

far simpler than writing code to do it.

u25103
09-09-2008, 04:10 AM
Hi again

Yes it works, but only when a single cell is active.
I've tried to select a bigger range but then nothing happens.

My worksheet is large and I use al ot of cells soI can't activate every single cell.

: pray2:
Thanks

Bob Phillips
09-09-2008, 04:45 AM
You have to select them all and repeatedly hit F2-Enter.

u25103
09-09-2008, 05:00 AM
I understand.....
But I have values in cells A1 to BC4000 so a haven't got the time to press F2 + enter in every cell.

:think: : pray2:
Thanks

Bob Phillips
09-09-2008, 05:03 AM
Run this little macro then


Public Sub Test()
Dim cell As Range
For Each cell In Range("A1:BC4000")
If Not cell.HasFormula Then
cell.Value = cell.Value
End If
Next cell
End Sub

u25103
09-09-2008, 05:56 AM
Thanks
One last question....
Is this a endless loop or will it stop when it have reached the last cell in the Range.

:bow: :thumb

Bob Phillips
09-09-2008, 05:58 AM
It is not endless, just a lot of cells to process.

Bob Phillips
09-09-2008, 05:59 AM
Perhaps I should have given


Public Sub Test()
Dim cell As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each cell In Range("A1:BC4000")
If Not cell.HasFormula Then
cell.Value = cell.Value
End If
Next cell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

u25103
09-09-2008, 06:02 AM
Thanks
...El XID...
:cloud9: :hi: :yay
You saved my day

Kenneth Hobs
09-09-2008, 06:44 AM
This won't help you since you have solved your problem with xld's fine help but others may find some value in my thoughts below.

Had you wanted to keep your formula intact but run the change event code, one can do it this way.

I am thinking that you may have used something like =RandBetween which would only trigger the Calculate event. There are other ways to do this of course. Here is one.

1. Make your Change code Public rather than Private. Add code to check each cell in the Target range rather than just one. This can be handy if you Change multiple target cells by copy/paste though making it Public would not matter in that case alone.

Public Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:C100" '<== change to suit
Dim c As Range, tCells As Range
On Error GoTo ws_exit
Application.EnableEvents = False
Set tCells = Intersect(Target, Me.Range(WS_RANGE))
If Not tCells Is Nothing Then
For Each c In tCells
With c
Select Case .Value
Case 1002: .Interior.ColorIndex = xlCIRed
Case 1005: .Interior.ColorIndex = xlCIYellow
Case 1015: .Interior.ColorIndex = xlCIBlue
Case 1019: .Interior.ColorIndex = xlCIGreen
Case Else: .Interior.ColorIndex = xlColorIndexNone
End Select
End With
Next c
End If
ws_exit:
Application.EnableEvents = True
End Sub


2. Using Sheet1 for the cells to change, put the xld's xlColorIndex code into a Module and this code:

Sub SetA1ToC100()
Sheet1.Worksheet_Change [A1:C100]
End Sub

3. We can now play the routine above to set the interior colors for Sheet1's A1:C100 with no Calculation event triggered which changes the values.

Another method is to use the Calculation event but that would execute each time something was calculated on Sheet1 which may or may not be what you wanted.