Column color fill

[rjplante]

I have a table (see table below) and I have a row that has 5 dates in 5 consecutive columns. There is a blank row between each set of data. I have five months of columns, each month a block of five columns. I would like to have a macro that would start at column G and check to see if Date 1 fits the case for that column (30 days divided by 5 = 6, so Case 1 = Date <6). If date 1 fits case 1, then add the date to the cell and change to color based on the color matrix. If the date in the date 1 column does not fit the case for column G, move one cell to the right and see if date 1 fits into that date range. and loop through the remaining cells until it reaches the end of the last month. When Date 1 is done, loop through the cells for Date 2, etc, through Date 5. Then I need it to skip the blank row and repeat the process for each row with data in it.

I have included a set of date numbers that correspond to the month in the top row, located in the cells below the table. I was thinking that this might be helpful in solving the date checking component. I have worked out a way to do this, but I use a large If then statement to do just one month for one date. Doing it this way would be very slow and tedious as well as take up a lot of code. I know there has to be a more elegant way to write the code than what I have.


Here is what I have started with. NOTE: The cell references are off because I have created a more simplified table the my original.
My VBA Code:

Dim VATDate As Date

VATDate = CDate(Range("J" & ActiveCell.Row))

If Month(VATDate) = Range("BG3").Value Then

    If Day(VATDate) <= 6 Then
    
        Range("R" & ActiveCell.Row).Interior.Color = RGB(255, 230, 150)
        Range("R" & ActiveCell.Row).Value = Range("J" & ActiveCell.Row).Value
        Range("S" & ActiveCell.Row).Select
        
    ElseIf Day(VATDate) > 6 And Day(VATDate) <= 12 Then
    
        Range("S" & ActiveCell.Row).Interior.Color = RGB(255, 230, 150)
        Range("S" & ActiveCell.Row).Value = Range("J" & ActiveCell.Row).Value
        Range("T" & ActiveCell.Row).Select
    
    ElseIf Day(VATDate) > 12 And Day(VATDate) <= 18 Then
    
        Range("T" & ActiveCell.Row).Interior.Color = RGB(255, 230, 150)
        Range("T" & ActiveCell.Row).Value = Range("J" & ActiveCell.Row).Value
        Range("U" & ActiveCell.Row).Select
    
    ElseIf Day(VATDate) > 18 And Day(VATDate) <= 24 Then
    
        Range("U" & ActiveCell.Row).Interior.Color = RGB(255, 230, 150)
        Range("U" & ActiveCell.Row).Value = Range("J" & ActiveCell.Row).Value
        Range("V" & ActiveCell.Row).Select
    
    ElseIf Day(VATDate) > 24 Then
    
        Range("V" & ActiveCell.Row).Interior.Color = RGB(255, 230, 150)
        Range("V" & ActiveCell.Row).Value = Range("J" & ActiveCell.Row).Value
        Range("W" & ActiveCell.Row).Select
    
    End If

End If

Data Table:

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE
1	Date 1	Date 2	Date 3	Date 4	Date 5	Display Data	May					June					July					August					September
2
3	1-Jun-2020	19-Jun-2020	26-Jun-2020	2-May-2020	1-Jul-2020
4
5	13-Jul-2020	25-Jul-2020	4-Aug-2020	13-Aug-2020	20-Aug-2020
6
7	1-Aug-2020	15-Aug-2020	22-Aug-2020	6-Sep-2020	11-Sep-2020
8
9
10
11
12							Case 1	Case 2	Case 3	Case 4	Case 5
13					Case 1	Date < 6
14					Case 2	Date > 6 AND Date <= 12											Color	R	G	B
15					Case 3	Date > 12 AND Date <= 18										Date 1		255	250	150
16					Case 4	Date > 18 AND Date <= 24										Date 2		215	240	200
17					Case 5	Date > 24										Date 3		255	215	215
18																Date 4		200	215	240
19																Date 5		255	220	255
20
21						Month Numbers	5	6	7	8	9
Sheet1

Cell Formulas
Range	Formula
G1	G1	=TEXT(TODAY(),"mmmm")
L1	L1	=TEXT(EDATE(TODAY(),BA1+1),"mmmm")
Q1	Q1	=TEXT(EDATE(TODAY(),BA1+2),"mmmm")
V1	V1	=TEXT(EDATE(TODAY(),BA1+3),"mmmm")
AA1	AA1	=TEXT(EDATE(TODAY(),BA1+4),"mmmm")
C3	C3	=IF(OR(B3="",B3="TBD"),"",B3+7)
G21	G21	=MONTH(TODAY())
H21:K21	H21	=G21+1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E3	Expression	=$C3="Bob"	text	NO
E3	Expression	=$C3="Bob"	text	NO
E3	Expression	=$C3="Andrew"	text	NO
E3	Expression	=$C3="Amber"	text	NO
E3	Expression	=$C3="Robert"	text	NO
E3	Expression	=$C3="Andrew"	text	NO
E3	Expression	=$C3="Amber"	text	NO
A3:E10	Expression	=$C3="Bob"	text	NO
A3:E10	Expression	=$C3="Bob"	text	NO
A3:E10	Expression	=$C3="Andrew"	text	NO
A3:E10	Expression	=$C3="Amber"	text	NO
A3:E10	Expression	=$C3="Robert"	text	NO
A3:E10	Expression	=$C3="Andrew"	text	NO
A3:E10	Expression	=$C3="Amber"	text	NO

Thanks for the help.

 

[DanteAmor]

Try this

In which row do you have the names of the months?
Check that the names of the months are in row 1 and that they are the full names of the month and are in text.

If they are on another line, then change the row number on this line of the macro
Set f = Rows(1).Find(m, , xlValues, xlWhole)

It is very important that the name of the month is a text. As you put it in your examples.

Sub Column_color_fill()
  Dim lr As Long, c As Range, f As Range, m As String, n As Long
  
  lr = ActiveSheet.Range("J:N").Find("*", , xlValues, , xlByRows, xlPrevious).Row
  Range("R5:AP" & lr).ClearContents
  Range("R5:AP" & lr).Interior.Color = xlNone
  
  For Each c In Range("J5:N" & lr).SpecialCells(xlCellTypeConstants)
    If c.Value <> "" And IsDate(c.Value) Then
      m = MonthName(Month(c.Value))
      n = WorksheetFunction.RoundUp(Day(c.Value) / 6, 0) - 1
      If n > 4 Then n = 4
      Set f = Rows(1).Find(m, , xlValues, xlWhole)
      If Not f Is Nothing Then
        With Cells(c.Row, f.Column + n)
          .Value = c.Value
          .Interior.Color = Cells(1, c.Column).Interior.Color
        End With
      End If
    End If
  Next
End Sub

 

[rjplante]

Dante,

I had the 1st and 2nd row merged together. I have unmerged them and made some minor formatting adjustments and it is working much better.

In my actual table, Date 3 is a formula that adds one week (7 days) to the value in Date 2. This date is not getting updated on the page with either color or date text in the cell. Everything else is updating as expected. All of the date columns are formatted as dates. What is the issue with this date not getting added to the table?

Thanks.