Can't get code to work properly. Please Help!

[sparky3883]

hi All.

I seem to be having a wee bit of trouble with some coding and wa
wondering if someone could please point me in the right direction o
how to fix it, and amend it.

The code is for a daily staff rota at my work. The main part of th
rota is shaded grey, and when you enter a 'shift' into column B th
times that the employee will be working change from grey to whit
automatically.
However, with the code that i currently have, it'll only change th
first shift from grey to white, all other shifts entered after tha
remain grey.
I did use to have a button called 'Fill Rota' which, when all shift
have been entered and the button is pressed, all the shift times chang
from grey to white. I decided to remove this button and have the shif
times change automatically when entered, but now i am having troubl
ammending it.

Can anyone please help me and point me in the right direction.

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range

Application.EnableEvents = False

If Not Intersect(Target, Columns(2)) Is Nothing Then
Range("D9:AJ106").Interior.ColorIndex = 15
Cells.ShrinkToFit = True
For Each cell In Range("B9:AJ106")
With cell
Select Case .text
Case "6~10"
Range("D" & cell.row). _
Resize(1, 8).Interior.ColorIndex = 0
Case "6~11"
Range("D" & cell.row). _
Resize(1, 10).Interior.ColorIndex = 0
Case "6~12"
Range("D" & cell.row). _
Resize(1, 12).Interior.ColorIndex = 0
Case "6~3"
Range("D" & cell.row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "7~4"
Range("F" & cell.row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "E"
Range("I" & cell.row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "8~5"
Range("H" & cell.row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "8.30~5.30"
Range("I" & cell.row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "9~6"
Range("J" & cell.row). _
Resize(1, 18).Interior.ColorIndex = 0
End Select

End With
Next cell
End If
End Sub


Sorry for the long thread. Thanks in advance for any hel

 

[Bob Phillips]

Try this Sparky


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

On Error GoTo ws_exit

Application.EnableEvents = False

If Not Intersect(Target, Columns(2)) Is Nothing Then
Range("D9:AJ106").Interior.ColorIndex = 15
Cells.ShrinkToFit = True
For Each cell In Range("B9:AJ106")
With cell
Select Case .Text
Case "6~10"
Range("D" & cell.Row). _
Resize(1, 8).Interior.ColorIndex = 0
Case "6~11"
Range("D" & cell.Row). _
Resize(1, 10).Interior.ColorIndex = 0
Case "6~12"
Range("D" & cell.Row). _
Resize(1, 12).Interior.ColorIndex = 0
Case "6~3"
Range("D" & cell.Row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "7~4"
Range("F" & cell.Row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "E"
Range("I" & cell.Row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "8~5"
Range("H" & cell.Row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "8.30~5.30"
Range("I" & cell.Row). _
Resize(1, 18).Interior.ColorIndex = 0
Case "9~6"
Range("J" & cell.Row). _
Resize(1, 18).Interior.ColorIndex = 0
End Select
End With
Next cell
End If

ws_exit:

Application.EnableEvents = True

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Patrick Molloy]

This is what Conditional Formatting can do for you very
easily and without the need for code!

use the Formula Is instead of Value Is
then enter
=($B2="")
then select format and choose the grey pattern

HTH
I can send you a demo iff you'd like

Patrick Molloy
Microsoft Excel MVP