Two colours in a single excel spreadsheet cell 1

[cpc34]

Is there a way of having two different colours in an excel cell? I am assessing some data using red/amber/green traffic lights, but I would like a way to indicate red/amber or amber/green. My thought was a diagonal divide across the cell with one colour in the top left and one in the bottom right, but really any way I can have 2 colours in the cell would be fine.
The Pattern function in Format Cells only seems to allow one chosen colour with black stripes (Excel 2000).
Any thoughts? Thanks.

 

[CautionMP]

cpc34,
CAUTION: Macro solution. If you're not interested in using a macro then there is no need to continue reading.

With that said, this post has gone all day without a response so here goes. To answer your question, no. But you can add shapes to an adjoining cell with a macro that will achieve a similar result.

Usage: In cell A1 I placed a number, in cell B1 I placed the formula [tt]=AddShape(A1)[/tt]. As I changed the value in cell A1, the shapes in cell B1 changed.

Now here are the two functions that make it work:

Function AddShape(CellValue As Range) As String
Dim MyRange As Range
Dim MyShape As Shape
Dim TopColor As Long, BottomColor As Long

Set MyRange = Application.Caller
'Remove any previous shapes
DeleteShape CellValue
'Make sure CellValue has a value
If CellValue.Value = 0 Then
  Exit Function
End If

'This is the logic that determines the two colors based
'on the value in CellValue
Select Case CellValue
  Case Is < 10
    TopColor = vbGreen
    BottomColor = vbGreen
  Case Is < 15
    TopColor = vbGreen
    BottomColor = vbYellow
  Case Is < 20
    TopColor = vbYellow
    BottomColor = vbYellow
  Case Is < 30
    TopColor = vbYellow
    BottomColor = vbRed
  Case Else
    TopColor = vbRed
    BottomColor = vbRed
End Select

'Now create the two shapes
With MyRange.Worksheet.Shapes
  Set MyShape = .AddShape(msoShapeRightTriangle, MyRange.Left, MyRange.Top, MyRange.Width, MyRange.Height)
  With MyShape
    .Name = "shp" & CellValue.Address & "b"
    .Fill.ForeColor.RGB = BottomColor
    .Locked = True
  End With
  Set MyShape = .AddShape(msoShapeRightTriangle, MyRange.Left, MyRange.Top, MyRange.Width, MyRange.Height)
  With MyShape
    .Name = "shp" & CellValue.Address & "t"
    .Fill.ForeColor.RGB = TopColor
    .Rotation = 180
  End With
End With
AddShape = ""
End Function

Sub DeleteShape(ThisCell As Range)
Dim ThatShape As Shape
For Each ThatShape In ThisCell.Worksheet.Shapes
  If ThatShape.Name Like "shp" & ThisCell.Address & "*" Then
    ThatShape.Delete
  End If
Next
End Sub

This is all a result of "huh, I wonder if I could do that".

Hope this helps,
CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[mintjulep]

Assuming that you don't want any other text in the cells:

Insert | Symbols | Block Shapes

Use whatever shapes strike you. Set the font color to whatever you want.

Set the background fill color to whatever else you want.

There you are, two colors in one cell.

 

[cpc34]

Thanks CMP. Working nicely. I've changed vbYellow to RGB(255,204,0) to match with the Gold colour I'm using elsewhere.
Only problem is that it gets very confused if you try to apply it to a merged cell. Oh well, we can't have everything!