View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones Norman Jones is offline
external usenet poster
 
Posts: 5,302
Default Change colour of cell depending on content

Hi Blain,

If you wish, you may send me your workbook:

norman_jones@NOSPAMbtconnectDOTcom

(Delete "NOSPAM" and replace "DOT" with a full stop [period] )

Alternatively, send me an email and I will respond with my test book.

BTW, to allow for the possibility that the formula is deleted or
overwritten, more robust would be:

'=============
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rng2 As Range

Set rng = Me.Range("A1") '<<==== CHANGE

On Error Resume Next
Set rng2 = Union(rng, rng.Precedents)
On Error GoTo 0

If Not rng2 Is Nothing Then
If Not Intersect(rng2, Target) Is Nothing Then
With rng
Select Case UCase(.Value)
Case "ANNE": .Interior.ColorIndex = 3
Case "BEN": .Interior.ColorIndex = 4
Case "CAROL": .Interior.ColorIndex = 5
Case "DAVID": .Interior.ColorIndex = 6
Case "EWAN": .Interior.ColorIndex = 7
Case "FREDA": .Interior.ColorIndex = 8
Case "GRAHAM": .Interior.ColorIndex = 9
Case "HARRY": .Interior.ColorIndex = 10
Case "IAN": .Interior.ColorIndex = 11
Case "JANE": .Interior.ColorIndex = 12
Case "KATE": .Interior.ColorIndex = 13
Case "LEN": .Interior.ColorIndex = 14
Case "MARY": .Interior.ColorIndex = 15
Case "NORA": .Interior.ColorIndex = 16
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
End If
End If
End Sub
'<<=============

The version change should, however, have no relevance to your problem.


---
Regards,
Norman