Colour format code

[LiAD]

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

 

[joel]

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]

Lovely!

Thanks a lot

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