VBA insert if - Change cell fill based on date

Question

Trying to do an insert if formula in VBA for the following;

In my column K I want three conditions:

• Date is Today or older (ie project is due today or earlier) = RED
• Date is Today + up to 7 days = Amber
• Date is Today less more than 7 days = Green

I was thinking of using something along the lines of:

Sub ChangeColor()
    lRow = Range("K" & Rows.Count).End(xlUp).Row
    Set MR = Range("K3:K" & lRow)
    For Each cell In MR
        If cell.Value = "TODAY" Then cell.Interior.ColorIndex = 10
        If cell.Value = "TODAY-7days" Then cell.Interior.ColorIndex = 9
        If cell.Value = "Morethan7Days" Then cell.Interior.ColorIndex = 8
    Next
End Sub

I've been trying but I'm not sure how to do it.

I think my way is correct yet I am not sure how to code the If date=-7days then and so on.

Can someone provide some guidance? :)

Answer 1

VBA has a Date function that returns today's date. Dates in VBA are the number of days since December 31, 1900 (usually and with a leap year bug), so you can subtract or add integers to Date to get past and future days.

Sub ChangeColor()

    Dim rCell As Range

    With Sheet1
        For Each rCell In .Range("K3", .Cells(.Rows.Count, 11).End(xlUp)).Cells
            If rCell.Value <= Date Then
                rCell.Interior.Color = vbRed
            ElseIf rCell.Value <= Date + 7 Then
                rCell.Interior.Color = vbYellow
            Else
                rCell.Interior.Color = vbGreen
            End If
        Next rCell
    End With

End Sub

Answer 2

Mr. Anderson is correct that you could accomplish this with conditional formatting however if you want to do this in VBA Create a variable to hold the date and set it to the current day minus the time. Then you just want to Format the cells value to a date format. Once this is done you can use dateAdd to and and subtract the days. See below

Sub ChangeColor()

Dim myDate As Date
'format the date excluding time
myDate = FormatDateTime(Now, 2)

lRow = Range("K" & Rows.Count).End(xlUp).Row
Set MR = Range("K3:K" & lRow)
    For Each cell In MR
        If FormatDateTime(cell.Value, 2) = myDate Then cell.Interior.ColorIndex = 10
        If FormatDateTime(cell.Value, 2) = DateAdd("d", -7, myDate) Then cell.Interior.ColorIndex = 9
        If FormatDateTime(cell.Value, 2) = DateAdd("d", 7, myDate) Then cell.Interior.ColorIndex = 8
    Next

End Sub

I did notice that your checking to see if it is equal so only dates that are exactly Todays date, 7 days from today and 7 days previous to today will have the interior color filled. greater than and less than to fill all interior cell colors

Sorry for all the edits