I want to be able to change the background colour of a cell depending on
its content, I could use conditional formatting but I have more than
three conditions.

I have 14 different conditions.

Can someone provide me a generic VBA code to accomplish this.

The content is text rather than a number.

Hope someone can help.


--
blain
------------------------------------------------------------------------
blain's Profile: http://www.excelforum.com/member.php...o&userid=34368
View this thread: http://www.excelforum.com/showthread...hreadid=552591

Will this work if the content of a cell is the result of a index forula

--
blai
-----------------------------------------------------------------------
blain's Profile: http://www.excelforum.com/member.php...fo&userid=3436
View this thread: http://www.excelforum.com/showthread.php?threadid=55259

Hi Blain,

Will this work if the content of a cell is the result of a index forula?

To allow for the formula, try the following version:

'=============
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 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 Sub
'<<=============


---
Regards,
Norman

I must be doing something wrong

I cut and pasted your code, changed the range and the contents of the
cases to match those on my worksheet and nothing happens.

where am I going wrong?


--
blain
------------------------------------------------------------------------
blain's Profile: http://www.excelforum.com/member.php...o&userid=34368
View this thread: http://www.excelforum.com/showthread...hreadid=552591

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

I see Norman has moved things on a bit.

2 comments
1. make sure Normans code is in the "microsoft excel objects" ... "this
workbook " section not in the "modules" section.

2. I don't think you would want to change the colour pallette for this
sort of use so use the RGB function rather than colourindex

Cheers


--
tony h
------------------------------------------------------------------------
tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074
View this thread: http://www.excelforum.com/showthread...hreadid=552591

"2."

Not sure I understand your advice.

Excel cells can only display 56 distinct colors at any one time and they are
all covered by ColorIndex. So using RGB and the color property add no
additional functionality.

--
Regards,
Tom Ogilvy


"tony h" wrote:


I see Norman has moved things on a bit.

2 comments
1. make sure Normans code is in the "microsoft excel objects" ... "this
workbook " section not in the "modules" section.

2. I don't think you would want to change the colour pallette for this
sort of use so use the RGB function rather than colourindex

Cheers


--
tony h
------------------------------------------------------------------------
tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074
View this thread: http://www.excelforum.com/showthread...hreadid=552591

Hi Tony,

I see Norman has moved things on a bit.

2 comments
1. make sure Normans code is in the "microsoft excel objects" ... "this
workbook " section not in the "modules" section.

To avoid possible confusion, my suggested code represents worksheet event
code and, as such, should be placed in the appropriate worksheet module -
not in the workbook's ThisWorkbook module and not in a standard module. For
more explicit instructions, see my initial response to Steve (Blain).

However, in the absence of a post by Steve, and to provide a contextual
closure to the thread, the file which Steve sent me (a) relied on links to a
table in another sheet and (b) related to an extended range rather than the
single cell implied in his initial post. This being the case, I suggested
replacing my initial Worksheet_Change code with an appropriately amended
Worksheet_Calculate procedure, e.g.:

'=============
Private Sub Worksheet_Calculate()
Dim rng As Range
Dim rCell As Range

On Error Resume Next
Set rng = Me.Range("A1:AA23"). _
SpecialCells(xlCellTypeFormulas, xlTextValues)
On Error GoTo 0

If Not rng Is Nothing Then
For Each rCell In rng.Cells
With rCell
Select Case UCase(.Value)
Case "G": .Interior.ColorIndex = 3
Case "G/S7": .Interior.ColorIndex = 4
Case "D14": .Interior.ColorIndex = 5
Case "D15": .Interior.ColorIndex = 6
Case "D16": .Interior.ColorIndex = 7
Case "COT MIX": .Interior.ColorIndex = 8
Case "DCOT14": .Interior.ColorIndex = 9
Case "D_CPS_14": .Interior.ColorIndex = 10
Case "DCOTBB14": .Interior.ColorIndex = 11
Case "COT/CPS": .Interior.ColorIndex = 12
Case "DCOTBB15": .Interior.ColorIndex = 13
Case "DCOTBB16": .Interior.ColorIndex = 14
Case "ISCBBsales": .Interior.ColorIndex = 15
Case "ISC/CRM": .Interior.ColorIndex = 16
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
Next rCell
End If

End Sub
'<<=============

As far as your second comment:

2. I don't think you would want to change the colour pallette for this
sort of use so use the RGB function rather than colourindex

is concerned, I would direct you to Tom Ogilvy's pithily pertinent response.


---
Regards,
Norman

Hi Blain,

I must be doing something wrong

Not a great deal except that it was difficult, without seeing your workbook,
to appreciate the usage of formula links to another sheet.

Having seen your sheet and the range of interest, I would advocate replacing
the suggested code with a Worksheet_Calculate procedure like:

'=============
Private Sub Worksheet_Calculate()
Dim rng As Range
Dim rCell As Range

On Error Resume Next
Set rng = Me.Range("A1:AA23"). _
SpecialCells(xlCellTypeFormulas, xlTextValues)
On Error GoTo 0

If Not rng Is Nothing Then
For Each rCell In rng.Cells
With rCell
Select Case UCase(.Value)
Case "G": .Interior.ColorIndex = 3
Case "G/S7": .Interior.ColorIndex = 4
Case "D14": .Interior.ColorIndex = 5
Case "D15": .Interior.ColorIndex = 6
Case "D16": .Interior.ColorIndex = 7
Case "COT MIX": .Interior.ColorIndex = 8
Case "DCOT14": .Interior.ColorIndex = 9
Case "D_CPS_14": .Interior.ColorIndex = 10
Case "DCOTBB14": .Interior.ColorIndex = 11
Case "COT/CPS": .Interior.ColorIndex = 12
Case "DCOTBB15": .Interior.ColorIndex = 13
Case "DCOTBB16": .Interior.ColorIndex = 14
Case "ISCBBsales": .Interior.ColorIndex = 15
Case "ISC/CRM": .Interior.ColorIndex = 16
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
Next rCell
End If

End Sub
'<<=============

I have implemented this code in the updated version of your workbook which I
have sent you and, from my limited perspective, your stated objectives are
satisfied.


---
Regards,
Norman

Thank you Norman, with that last code everything works just fine.


--
blain
------------------------------------------------------------------------
blain's Profile: http://www.excelforum.com/member.php...o&userid=34368
View this thread: http://www.excelforum.com/showthread...hreadid=552591