Changing cell colors based on day of the week

wjoyner

New Member
Joined
Feb 17, 2002
Messages
9
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!
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Could you provide a little more info on how your sheet is layed out? Do you have the dates on the sheet?
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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".
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top