Interior color based on dates

[Michael Wise]

I have a worksheet that I want a specific color each month in the lowest
found date. I want a constant color to be with the lowest date. For
example if in my data range the lowest Month is 6/1/05 I wish it to be
light blue and the next date change month to 7/1/05 to be light green.
The color I wish to be constant in there placement but the date will
always be changing. The date are sorted. Also the colors only need to
be changed if the month itself is different not the days of the month.
This should happen from row 2 on. So all rows in the current month
would be light blue all next month rows would be light green, all next
month after that rows would be light yellow, anything beyond that is
N/A. The Interior fill only needs to be applied to columns A:J. I hope
this makes sense and i've explained well enough. TIAdvance
Michael

 

[Norman Jones]

Hi Michael,

Try:


Sub ColorByMonth2()
Dim Rng As Range
Dim rCell As Range

Set Rng = Intersect(ActiveSheet.UsedRange, Columns("A:J"))

For Each rCell In Rng.Cells
If IsDate(rCell) Then
With rCell.Interior
Select Case Month(rCell.Value)
Case 1: .ColorIndex = 35
Case 2: .ColorIndex = 3
Case 3: .ColorIndex = 4
Case 4: .ColorIndex = 5
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 15
Case 7: .ColorIndex = 16
Case 8: .ColorIndex = 17
Case 9: .ColorIndex = 18
Case 10: .ColorIndex = 19
Case 11: .ColorIndex = 8
Case 12: .ColorIndex = 7
End Select
End With
End If
Next
End Sub

You may wish to try changing the color index numbers to match your personal
predilections.

---
Regards,
Norman



"Michael Wise" <[email protected]>
wrote in message
news:[email protected]...

 

[Michael Wise]

This actually sets only column J to the color dictated. I'm needing it
to be the associated row A-J. Also once it set the first date color it
uses the same color thru the rest of the column. I'm working with this
code to see what I can modify but if someone can help in the mean time
it would be great. Thanks
Michael

 

[Norman Jones]

Hi Michael,

This actually sets only column J to the color dictated.

No, The procedure operates on all date cells in the designated range which,
in the code, was set to encompass all cells in columns A:J of the used
range.

Two possibilities suggest themselves:

(1) You have (wittingly or not) amended the code, or
(2) Your data in columns A:I includes cells that you perceive as
dates which are
unrecognised by Excel as such.

Providing neither of these conditions pertains, I am unable to reproduce
your experience.

It should be noted, however, that the code is not dynamic: date cells will
only be colored when the code is run and the applied formatting will remain,
irrespective of subsequent change of data, until the code is run again or
the format is changed manually.

If you need the code to operate dynamically, you would need to adapt the
code to run from a WorkSheet_Change event.

---
Regards,
Norman



"Michael Wise" <[email protected]>
wrote in message

 

[Michael Wise]

Yep option 2 I appologize I failed to mention that columns A thru I d
not have dates only column J. And I failed to mention that column K,L,
also need to change so the whole row of Columns A-M need to change base
on the date of column J. Sorry for not clarifin

 

[Norman Jones]

Hi Michael,

Reading your last post in conjunction with your earlier posts, it is not
easy to decipher your requirements.

Taking the plunge I have assumed that what you want that:

- The first row having a date in column J should be colored

- Each subsequent row should be colored using the same color

- At each month change the color should change

On these assumptions, try:

Sub ColorByMonth3()
Dim Rng As Range, rng2 As Range
Dim rCell As Range
Dim WB As Workbook
Dim WS As Worksheet
Dim iDate As Long
Dim fCell As Range, lCell As Range
Dim finalCell As Range


Set WB = ThisWorkbook
Set WS = WB.Sheets("Sheet1")

WS.Cells.Interior.ColorIndex = xlNone

Set Rng = Intersect(WS.UsedRange, WS.Columns("J"))
If Rng Is Nothing Then Exit Sub

Set Rng = Rng.Resize(Rng.Cells.Count + 1)
Set finalCell = Rng.Cells(Rng.Cells.Count)

For Each rCell In Rng
If IsDate(rCell) Or rCell.Address = finalCell.Address Then
If Month(rCell) <> iDate Then
iDate = Month(rCell)
On Error Resume Next
If Not Intersect(rCell.Offset(-1), _
ActiveSheet.UsedRange) Is Nothing Then
Set lCell = rCell.Offset(-1)
End If
On Error GoTo 0
If Not lCell Is Nothing Then

On Error GoTo XIT
Set rng2 = Range(lCell, fCell)
On Error GoTo 0

Set rng2 = rng2.Offset(, -9).Resize(, 13)

With rng2.Interior
Select Case Month(fCell.Value)
Case 1: .ColorIndex = 35
Case 2: .ColorIndex = 3
Case 3: .ColorIndex = 4
Case 4: .ColorIndex = 5
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 15
Case 7: .ColorIndex = 16
Case 8: .ColorIndex = 17
Case 9: .ColorIndex = 18
Case 10: .ColorIndex = 19
Case 11: .ColorIndex = 8
Case 12: .ColorIndex = 7
End Select
End With
End If
Set fCell = rCell
End If
End If
Next

Exit Sub

If my assumptions are incorrect, post back.

---
Regards,
Norman



"Michael Wise" <[email protected]>
wrote in message
news:[email protected]...