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

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

--
Message posted from http://www.ExcelForum.com

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

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)

"sparky3883 " wrote in message
...
hi All.

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

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


---
Message posted from http://www.ExcelForum.com/

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

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



-----Original Message-----
hi All.

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

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


---
Message posted from http://www.ExcelForum.com/

.