Not enough conditional formats

xyzabc198

Board Regular
Joined
Jul 30, 2008
Messages
126
I recently tried to create conditional formatting for the following

If cell = CB turn Yellow Black text bold and itallic
If cell = S/Lit turn Bright Green Black text bold and itallic
If cell = NI turn Gray 40% Black text bold and itallic
If cell = email turn Aqua Black text bold and itallic
If cell = MR turn Lime Black text bold and itallic
If cell = Cleansed turn Rose Black text bold and itallic
If cell = Dup turn Tan Black text bold and itallic
If cell = DNC turn Red Black text bold and itallic
If cell = KW turn Light Orange Black text bold and itallic
If cell = Lead turn Lavander Black text bold and itallic
If cell = LTC turn Plum with white text Bold & Itallic
If cell = Appt turn Pink Black text bold and itallic
If cell = Quote turn Light Blue white text Bold & Itallic
If cell = XAPPT turn Sea Green Black text bold and itallic
If cell = XC turn Dark Yellow Black text bold and itallic

Obviously there is only 3 conditionals available, not 15...
Any other way to do this? maybe a macro? thanks!
 
im sure a search will reveal that but it will be a number between 1 and 100 lol so keep guessing ;)
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
I FINALLY, have the PERFECT database, took alot of time though, I wanna thank everybody that provided codes and advice, you've been a great help, thankyou
 
Upvote 0
Here is the final finished code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Value
Case "CB"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.Color = vbYellow
End With
Case "S/Lit"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.Color = vbGreen
End With
Case "Email"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 42
End With
Case "NI"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.Color = RGB(220, 220, 220)
End With
Case "Dup"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 40
End With
Case "MR"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 43
End With
Case "Cleansed"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 38
End With
Case "DNC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 3
End With
Case "KW"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 45
End With
Case "Lead"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 39
End With
Case "LTC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 13
End With
Case "Appt"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 7
End With
Case "Quote"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 41
End With
Case "Xappt"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 50
End With
Case "XC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 12
End With
End Select

HAHA that was fun
 
Upvote 0
Ah actually, it's not perfect, one more little thing;

I have noticed I cannot select multiple cells without it asking me to "debug" is there a way to stop this easily?
Does it have something to do with the way the formatting is applied (IE by having to highlight the cell again, and therefore could the code be modified to work simply when I click out the cell instead)?
 
Upvote 0
Rich (BB code):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
On Error GoTo ERRTRP
 
Select Case Target.Value
Case "CB"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.Color = vbYellow
End With
Case "S/Lit"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.Color = vbGreen
End With
Case "Email"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 42
End With
Case "NI"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.Color = RGB(220, 220, 220)
End With
Case "Dup"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 40
End With
Case "MR"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 43
End With
Case "Cleansed"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 38
End With
Case "DNC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 3
End With
Case "KW"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 45
End With
Case "Lead"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 39
End With
Case "LTC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 13
End With
Case "Appt"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 7
End With
Case "Quote"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 41
End With
Case "Xappt"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 50
End With
Case "XC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 12
End With
End Select
 
ERRTRP:
Exit Sub
 
End Sub

New lines are in RED. It was crashing because when making a multiple selection it was trying to apply the code to all of the cells, and crashing. You will still need to click on each cell (or just hold the down arrow!) to make them format or Update.

I tested it and it worked fine.
 
Last edited:
Upvote 0
Change
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Value
Case "CB"
With Target

to

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For Each C in Target
Select Case C.Value
Case "CB"
With C

Then change EVERY "With Target" line
to

"With C"

Then add
Next C
at the end.
That should do.
 
Upvote 0
I decided to go with Jonmo's idea, worked a treat, thanks for the idea.

And if anybody DOES come up with a way for it to update automatically without having to click back onto it that would be fantastic, also, a way to make "blank" change to just a "automatic" background would be good, because at the moment if I type in CB and then decide that is wrong and delete it, it stays yellow.

But thanks for everybodies help, I know im a pain haha :P
 
Upvote 0
For blank cells try:

Rich (BB code):
Case ""
With C
.Font.Bold = False
.Font.Italic = False
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End With

UPDATED: This code now works for returning blank cells to have no fill colour or formatting.
 
Last edited:
Upvote 0
And if anybody DOES come up with a way for it to update automatically without having to click back onto it
Change
Worksheet_SelectionChange
to
Worksheet_Change

a way to make "blank" change to just a "automatic" background would be good

Add a "Case Else" statement at the end.

Code:
Case "XC"
With Target
.Font.Bold = True
.Font.Italic = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 12
End With
Case Else
With Target
.Font.Bold = False
.Font.Italic = FAlse
.Font.ColorIndex = 0
.Interior.ColorIndex = xlnone
End With

End Select
 
Upvote 0

Forum statistics

Threads
1,216,025
Messages
6,128,348
Members
449,443
Latest member
Chrissy_M

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top