Try this code
Private Sub Worksheet_Change(ByVal Target As Range)
MyBlue = 5
MyGreen = 10
MyBrown = 9
MyBlack = 1
MyGrey = 15
MyWhite = 2
Set i = Range("I4:K20")
Set t = Target
If Intersect(t, i) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case UCase(Cells(t.Row, "I"))
Case "BLUE": MyBack = MyBlue
MyWhite = MyBlack
Case "GREEN": MyBack = MyGreen
MyFont = MyBlack
Case "BROWN": MyBack = MyBrown
MyFont = MyBlack
Case "BLACK": MyBack = MyBlack
MyFont = MyWhite
Case "GREY": MyBack = MyGrey
MyFont = MyBlack
Case Else
Exit Sub ' color is no good
End Select
'clear old colors
Range(Cells(t.Row, "k"), Cells(t.Row, "k").Offset(0, 23)) _
.Interior.ColorIndex = xlColorIndexNone
'make font black
Range(Cells(t.Row, "k"), Cells(t.Row, "k").Offset(0, 23)) _
.Font.ColorIndex = MyWhite
StartTime = Cells(t.Row, "J")
EndTime = Cells(t.Row, "K")
If StartTime <> "" And _
IsNumeric(StartTime) Then
'Start time is valid
If EndTime <> "" And _
IsNumeric(EndTime) Then
'both starttime and end time are good
Range(Cells(t.Row, "L").Offset(0, StartTime), _
Cells(t.Row, "L").Offset(0, EndTime)).Interior.ColorIndex = MyBack
Range(Cells(t.Row, "L").Offset(0, StartTime), _
Cells(t.Row, "L").Offset(0, EndTime)).Font.ColorIndex = MyFont
Else
'Start Time good end time not good
Cells(t.Row, "L").Offset(0, StartTime).Interior.ColorIndex = MyBack
Cells(t.Row, "L").Offset(0, StartTime).Font.ColorIndex = MyFont
End If
Else
If EndTime <> "" And _
IsNumeric(EndTime) Then
'Start time no good, end time good
Cells(t.Row, "L").Offset(0, EndTime).Interior.ColorIndex = MyBack
Cells(t.Row, "L").Offset(0, EndTime).Font.ColorIndex = MyFont
Else
'start time and end time no good
End If
End If
Application.EnableEvents = True
End Sub
"LiAD" wrote:
> Hi,
>
> I have a worksheet that I need to fill with five different colours, (none of
> which are white) to represent a timeline of activities.
>
> From cell I4 going vertically downwards I have the colours I want, blue,
> green, brown, black and grey.
> In cell J4 and going downwards I have the starting hours of the action
> In cell K4 and going downwards I have the finishing hours for each action
> Each cell going horizontally across from each line represents one hour
> starting from L4, (starting from cell L2 I actually have a horizontal list
> going 0, 1, 2 etc to represent the hours but I don’t need this if its not
> useful).
>
> Is it possible to have a code that will fill in each cell starting from L4
> with colour that is in I from the start time to the finish time. For example;
>
> Blue 0 2 – excel fills in cells L4 and M4 in blue
> Black 2 6 – excel fills in cells M5 to Q5 in black
> Green 6 7 – excel fills in cells Q6 to R6 in green
>
> The items that I need to keep changeable are the colours in each row, the
> number of hours per task and the amount of cells that are coloured (i.e. on
> some sheets there will be 10 rows coloured the others 30).
>
> I actually have this code which works well and I can set an IF to change the
> text to a number to drive the colours from, the bit I can’t get is how to
> make it fill more than one cell horizontally based on the start and finish
> hours.
>
> Is it possible to adapt this code to do that function?
>
> Thanks a lot
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> Set i = Range("I4:I20")
> Set t = Target
> If Intersect(t, i) Is Nothing Then Exit Sub
> v = t.Value
> If v > 56 Then Exit Sub
> Application.EnableEvents = False
> Cells(t.Row, "L").Interior.ColorIndex = v
> Cells(t.Row, "L").Font.ColorIndex = Target
> Application.EnableEvents = True
> End Sub
>
Similar Threads
