Color format

[u25103]

Hi
This is my problem...
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

[Bob Phillips]

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]

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]

Yes, select them all and just F2-Enter, it will trigger the code.

far simpler than writing code to do it.

[u25103]

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.


Thanks

[Bob Phillips]

You have to select them all and repeatedly hit F2-Enter.

[u25103]

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.


Thanks

[Bob Phillips]

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]

Thanks
One last question....
Is this a endless loop or will it stop when it have reached the last cell in the Range.

[Bob Phillips]

It is not endless, just a lot of cells to process.

[Bob Phillips]

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]

Thanks
...El XID...

You saved my day

[Kenneth Hobs]

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.