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/