color formatting based on 12 conditions

S

scire

Need help
Like to create a user function to color the fill based on a text character in a range (B2:af37)
P = color
F = color
S = color
V and 4 = color 3
W = color 3
C = color 4
M = color 4
T = color
B = color 4
H = color 3
J = color 3
Thanks for your help.
 
F

Frank Kabel

Hi
a user defined function (which is invoked in the worksheet) can't do
this. Reason: A worksheet formula can only return values but not change
formats.

For this you need an event procedure (e.g. using the worksheet_change
event)


--
Regards
Frank Kabel
Frankfurt, Germany

scire said:
Need help.
Like to create a user function to color the fill based on a text
Click to expand...
character in a range (B2:af37).
 
D

David McRitchie

Hi "scire" <[email protected]>,
As Frank said when you can't use an Conditional Formatting
beyond three formats you can use an Event macro. see

Event Macros, Worksheet Events and Workbook Events
http://www.mvps.org/dmcritchie/excel/event.htm#case

Private Sub Worksheet_Change(ByVal Target As Range)
'David McRitchie, 2000-08-08 rev. 2000-08-14
' mod 2004-05-15 for "scire" <[email protected]>,
' http://www.mvps.org/dmcritchie/excel/event.htm#case
Dim vLetter As String
Dim vColor As Integer
Dim cRange As Range
Dim cell As Range
'***** if you really just want to check the rows use something like:
'--------- if target.row < 2 then exit sub

'***************** check range ****
Set cRange = Intersect(Range("B2:af37"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub
'**********************************
For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 1))
'see colors.htm and event.htm in same directory as
' http://www.mvps.org/dmcritchie/excel/excel.htm
vColor = 0 'default is no color
Select Case vLetter
Case "B"
vColor = 48
Case "C"
vColor = 45
Case "F"
vColor = 6
Case "H"
vColor = 38
Case "J"
vColor = 36
Case "P"
vColor = 7
Case "S"
vColor = 3
Case "T"
vColor = 4
Case "V"
vColor = 37
Case "4"
vColor = 37
Case "w"
vColor = 39
End Select
Application.EnableEvents = False 'should be part of Change macro
cell.Interior.ColorIndex = vColor
Application.EnableEvents = True 'should be part of Change macro
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
End Sub

To install right click on sheet tab name, view code, insert the above code

You can use a normal macro to reinstate a changed Change Event macro
or preexisting entries.

Sub ReEnterForChangeMacro()
'D.McRitchie, programming, 2004-05-15
'-- Your change event macro will recolor each cell in selection
Dim CurrCell As Range
On Error Resume Next 'in case nothing in selection
'--Selection.Interior.ColorIndex = xlNone 'rely on change macro
For Each CurrCell In Selection.SpecialCells(xlConstants)
CurrCell.Formula = Trim(CurrCell.Formula)
Next
For Each CurrCell In Selection.SpecialCells(xlFormulas)
CurrCell.Formula = Trim(CurrCell.Formula)
Next
End Sub

When using an interior color, gridlines are wiped out so you might
want to create black borders.

Ctrl+A (select all cells)
Format, cells, borders, choose: color, and line type,
choose: border location (inside/outside borders)
 
Top