Changing cell colors based on day of the week
Power Query Course in Spanish
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 7 of 7

Thread: Changing cell colors based on day of the week

  1. #1
    New Member
    Join Date
    Feb 2002
    Location
    Wayne Joyner - Omaha, NE
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    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!

  2. #2
    Board Regular Steve Hartman's Avatar
    Join Date
    Feb 2002
    Location
    Houston,Texas
    Posts
    417
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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

  3. #3
    New Member
    Join Date
    Feb 2002
    Location
    Wayne Joyner - Omaha, NE
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  4. #4
    New Member
    Join Date
    Feb 2002
    Location
    Wayne Joyner - Omaha, NE
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.

  5. #5
    MrExcel MVP DRJ's Avatar
    Join Date
    Feb 2002
    Location
    California
    Posts
    3,853
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  6. #6
    New Member
    Join Date
    Feb 2002
    Location
    Wayne Joyner - Omaha, NE
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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".

  7. #7
    New Member
    Join Date
    Feb 2002
    Location
    Wayne Joyner - Omaha, NE
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    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

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com