change colour of cells (more than 3 colours)

[Mrs T]

Hi, I was wondering if it was possible to change the colour of cells depending on the value. I know I can do it using conditional formatting, but am stuck when I need more than 3 colours. I would like to enter 'r' if a child is in red group, 'p' if a child is in purple group etc...I have 10 colours. Ideally I would like the colour of the letter I have entered to change to the same colour as the background so if I enter 'r' the cell just looks red. Can this be done in Excel 2003?
Thanks, Mrs T.

groups.xls

[jeffreybrown]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim rng As Range
     Set rng = Range("B4:I23")
     If Not Intersect(Target, rng) Is Nothing Then
        Select Case Target.Value
        Case "r"
            Target.Interior.ColorIndex = 3
        Case "o"
            Target.Interior.ColorIndex = 46
        Case "g"
            Target.Interior.ColorIndex = 51
        Case "p"
            Target.Interior.ColorIndex = 39
        Case "y"
            Target.Interior.ColorIndex = 36
        End Select
     End If
End Sub

I did not add all the criteria,but maybe you can follow the theme.

Here is where you can get the colors from

http://dmcritchie.mvps.org/excel/colors.htm

[Mrs T]

Hi Jeff, thanks for your reply - sorry if I sound a bit dumb here, but what formula do I put in the cells to link to the code?

[jeffreybrown]

This code goes into the worksheet module

See if this helps...

http://www.rondebruin.nl/code.htm

After entering the code, now you just change a value in the spreadsheet and it will act upon the code

[Mrs T]

I must be doing something wrong. I have gone into 'tools', 'macro', 'visual basic editor and followed the instructions from your link above. I have attached a print of my screen so you can see where I'm at.
screen.jpg

Thanks, Mrs T

[jeffreybrown]

See if this example works for you...

[Mrs T]

Perfectly! No idea where I went wrong - thank you very much

[jeffreybrown]

You are very welcome. Glad it worked out for you and thanks for the feedback

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save

[grizzly6969]

another code to change fonts and background colour

[grizzly6969]

this is not case sensitive

[Mrs T]

That's also great! Can you tell me how to get these to work in other workbooks? (In very basic terms!!)
Thanks

[grizzly6969]

right click on worksheet tab then click "view code" on the left double click on the sheet you want the code in just copy and paste the code that was given into the space on right side. you can continue to add colours as required

[Mrs T]

I've tried that and it doesn't work. I have a module code in this workbook as well, will that be making a difference? This is driving me nuts!

[grizzly6969]

shouldn't -- try opening a new workbook and paste the code in and see if it works

Private Sub Worksheet_Change(ByVal Target As Range)
     
    Dim Cell As Range
    Dim Rng1 As Range
     
    On Error Resume Next
    Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
    On Error GoTo 0
    If Rng1 Is Nothing Then
        Set Rng1 = Range(Target.Address)
        Target.Value = UCase(Target.Value)
    Else
        Set Rng1 = Union(Range(Target.Address), Rng1)
    End If
    For Each Cell In Rng1
        Select Case Cell.Value
        Case vbNullString
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        Case "R"
            Cell.Interior.ColorIndex = 3
            Target.Font.ColorIndex = 3   'Red
        Case "P"
            Cell.Interior.ColorIndex = 29
            Target.Font.ColorIndex = 29   'PURPLE
  Case "Y"
            Cell.Interior.ColorIndex = 6
            Target.Font.ColorIndex = 6   'YELLOW
 Case "O"
            Cell.Interior.ColorIndex = 46
            Target.Font.ColorIndex = 46   'ORANGE
        Case "B"
         Cell.Interior.ColorIndex = 1
         Target.Font.ColorIndex = 1   'BLACK
              Case Else
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        End Select
    Next
     
End Sub

[Mrs T]

It works perfectly in a new workbook, but not in one that I want it to! This is what I have already in that workbook:

Function CONCATIF(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
            Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
    ' code base by Mike Rickson, MrExcel MVP
    ' used as exactly like SUMIF() with two additional parameters
    ' of delimiter and "no duplicates" as TRUE/FALSE if concatenated values
    ' might include duplicates  ex. =ConcatIf($A$1:$A$10,C1,$B$1:$B$10,", ",True)

Dim i As Long, j As Long

With compareRange.Parent
    Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
End With

If compareRange Is Nothing Then Exit Function
If stringsRange Is Nothing Then Set stringsRange = compareRange
Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
                                    stringsRange.Column - compareRange.Column)
    
    For i = 1 To compareRange.Rows.Count
        For j = 1 To compareRange.Columns.Count
            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                If InStr(CONCATIF, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                    CONCATIF = CONCATIF & Delimiter & CStr(stringsRange.Cells(i, j))
                End If
            End If
        Next j
    Next i
    CONCATIF = Mid(CONCATIF, Len(Delimiter) + 1)
End Function

[grizzly6969]

Not sure - I will ( call in the calvary ) and see if some one can help

[Mrs T]

Thank you!

[grizzly6969]

this may take awhile but I'm sure some one will be able to help

[TMS]

Could you post the workbook that you want it to work in ... or a sample ... so we can see what you are working with? If it has any sensitive information, you should edit that or delete it. We only really need to see the structure and cells with the colour formatting.

Thanks, TMS

[Mrs T]

Hi,
thanks for all your help everybody. I deleted a couple of unessential columns in my sheet and for some reason it started to work! You all deserve a medal

[TMS]

Clearly you did the final problem resolution but thanks for the rep anyway.

Unfortunately, range addresses in VBA code do not adjust automatically as they do in a worksheet. By deleting columns, you may now have alignment between your data and the VBA code.

Regards, TMS