Changing cell colors based on day of the week

[wjoyner]

I know I posted this earlier this week, but received only one response which didn't provide me a answer I can put to use right away. I would really like to find a way of doing this automatically.

I would like to set a range of cells to a particular color based on the day of the week. For example: Monday would be blue, Tuesday, yellow, etc. Additionally, I would for the worksheet to figure our what day of the week it is based on a 02/18/02 date entry format. So today for example, it being - 02/18/02 (Monday) would set cells A1:A5 to a Light Blue background with black font. This is probably easy for some of you, but doing this manually is a real pain. I appreciate any help you can offer. Thanks! Nice Board!

[Steve Hartman]

Could you provide a little more info on how your sheet is layed out? Do you have the dates on the sheet?

[wjoyner]

Sheet Format is as follows:

Date Ticket Number Category Issue _ Person Status

02/18/02 567891 ANDS Database won't start Terry Open
02/18/02 567922 Codetables Files Missing Terry Closed

[wjoyner]

Thank you very much. This is just what I was looking for. You all are great! I hope I can contribute to this board some day with the same expertice.

[DRJ]

An easy way would be to use conditional formatting, however you would only get three different formats. To do more you will have to use VBA.

As for having excel figure out the day from a date format the cell as custom (DDDD) then put in the date and excel will display the day.

For coloring the cells try soomething like this.

Sub Workbook_Open

Dim MyRange as Range

MyRange =The range you want to color based on the day

select case application.worksheetfunction.text(date(),"DDDD")

case "Sunday"

range(myrange).interior.colorindex = 3
'Or
range(myrange).interior.color = "Red"

'Do this for each case based on the settings you want for that day.

case "Monday"

case "Tuesday"

case "Wednesday"

case "Thursday"

case "Friday"

case "Saturday"

end select

end sub

HTH

DRJ

[wjoyner]

I'm sorry, but the answer given I have tried with no success. I understand what the worksheet function is doing and that does work. However; making range color changes does not. I guess I am having a hard time understanding how to make the function look at each cell in the date column for the day of the week. Selecting the case based on the value in the date field makes sense, but the range is causing a "SUBSCRIPT Out Of Range error".

[wjoyner]

I know this is a long post, but this listing colors the range based on day of the week and places grid aound only those cells. Works pretty slick. Sorry it took me so long to figure it out. I appreciate everyone's help. I ended up doing it a different way, so you may want to read through this and make some suggestions for improvement. Please and thanks.

Private Sub Workbook_Open()

For RowCount = 1 To 100

' Color Background of Cells based on Day of the Week

If Range("A1").Offset(RowCount - 1, 0).Text = "Sunday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 3

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

If Range("A1").Offset(RowCount - 1, 0).Text = "Monday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 28

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

If Range("A1").Offset(RowCount - 1, 0).Text = "Tuesday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 44

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

If Range("A1").Offset(RowCount - 1, 0).Text = "Wednesday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 4

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

If Range("A1").Offset(RowCount - 1, 0).Text = "Thursday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 17

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

If Range("A1").Offset(RowCount - 1, 0).Text = "Friday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 6

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

If Range("A1").Offset(RowCount - 1, 0).Text = "Saturday" Then
Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Cells.Interior.ColorIndex = 3

' Place blocks around active cells in table

Range("A1").Offset(RowCount - 1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
End If

Next RowCount

End Sub