Colouring Cells

[Dazzawm]

I have these initials below in these cells on the spreadsheet. How do I do it that when I enter any of these initials anywhere on the spreadsheet it colurs the cell in with the allocated colour?

Thanks

<b>Sheet1</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:85px;" /><col style="width:114px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="background-color:#ffff00; font-weight:bold; text-align:left; ">HP</td><td style="background-color:#99cc00; font-weight:bold; text-align:left; ">RD</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="background-color:#00ccff; font-weight:bold; text-align:left; ">SU</td><td style="background-color:#ff6600; font-weight:bold; text-align:left; ">MP</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="background-color:#ffcc00; font-weight:bold; text-align:left; ">SP</td><td style="font-weight:bold; "> </td></tr></table> <br /><br /><span style="font-family:Arial; font-size:9pt; font-weight:bold;background-color:#ffffff; color:#000000; ">Excel tables to the web >> </span><a style ="font-family:Arial; font-size:9pt; color:#fcf507; background-color:#800040; font-weight:bold;"

 

[Dartagnan]

The following code is working for me. Also, if you want to use it for the whole worksheet then rem (put a single quote ' ) on the If and End If lines.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim intclr As Integer
If Application.Intersect(Range("A1"), Range("AA500")) Is Nothing Then
Select Case Target
Case "T"
intclr = 40
Case "Y"
intclr = 36
Case "C"
intclr = 35
Case "S1" To "S8"
intclr = 37
Case "O" To "o"
intclr = 43
Case "L1" To "L8"
intclr = 42
Case Else
End Select
Target.Interior.ColorIndex = intclr
End If
End Sub

 

[kpark91]

An error come up kpark91 - complie error 'end if without block if'

Just delete "End If" from the code.

 

[Dazzawm]

Sorted at last!!! Thanks all.

 

[jeffreybrown]

Glad it finally worked out for you

 

[Dazzawm]

Hi. I am using dartagnans code but if I enter something in a cell by mistake and try deleting it it keeps debugging with runtime error 13 and points to the first 'Case' in yellow. How than this be stopped please? Thanks.

 

[jeffreybrown]

Seems you might be trying to delete more than one cell at a time. Is this the case? I tested Dartagnan's post and it works fine; however, if you try to delete more than one cell at a time you get the run time error 13.

To prevent this add the line of code below right above the Select Case statement.

If Target.Count > 1 Then Exit Sub

 

[Dazzawm]

That was the case and I added the line you said, but... it is now debugging to another code I have in the workbook 'MsgBox Target & " Has " & c & " Days Booked"

 

[jeffreybrown]

Is this in the same workbook change event?

Can you post the code?

 

[Dazzawm]

Not sure what you mean by that but it does have a line sperating the 2 codes.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Long
Cancel = True
If Not Intersect(Target, Columns("B:B")) Is Nothing Then
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("C" & Target.Row), Cells(Target.Row, Columns.Count).End(xlToLeft))
For Each Dn In Rng
If Dn = "HP" Then c = c + 1
Next Dn
End If
MsgBox Target & " Has " & c & " Days Booked So Far This Year"
End Sub

 

[Dazzawm]

Any help on this error please?