Change colour of cell depending on content

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.

As always a few questions of clarification.

1. do the changes need to take place dynamically or can they take place by the user running a macro (or in a workbook event eg on save)?

2. are the 14 conditions 14 items that you need to test to determine the colour, or are there 14 different colours that you use for colouring?

The point in the last question is that the three conditions relate to three result positions eg condition 1 colours red, condition 2 colours blue, condition 3 colours yellow. Each can take a complex formula to determine this state.


3. With complex conditions it is worth looking at putting an additional hidden row or column. then use a formula in that row or column that returns (say 1,2,3 for red,blue,yellow) then the conditional formatting is easy. In my view much easier to debug.

Hi Blain,

Try something like:

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

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

If Not Intersect(rng, 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
End Select
End With
End If

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

This is worksheet event code and should be pasted into the worksheets's code
module (not a standard module and not the workbook's ThisWorkbook module):

Right-click the worksheet's tab
Select 'View Code' from the menu and paste the code.
Alt-F11 to return to Excel.


---
Regards,
Norman



"blain" <[email protected]> wrote in
message news:[email protected]...
>
> 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
>

Hi Blain,

Replace:

> Case "NORA": .Interior.ColorIndex = 16

with
Case "NORA": .Interior.ColorIndex = 16
Case Else: .Interior.ColorIndex = xlNone

---
Regards,
Norman

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?

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

re: "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.