Highlight cells based on date value

[Legacy 477849]

Hi, I'm new to VBA and would appreciate some help on this. I have a dataset as follows and would like to highlight my cells based on the following rules.

Col A	Col B	Col C	Col D
Stage 1 (header row)	Stage 1 (header row)	Stage 2 (header row)	Stage 2 (header row)
Target date (sub-header)	Actual date (sub-header)	Target date (sub-header)	Actual date (sub-header)
xx	xx	xx	xx

• For each stage (i.e. stage 1 or 2), if the actual date is later than the target date, to highlight the cell for Actual date (col B and/or D) in red.
• For each stage (i.e. stage 1 or 2), if the actual date is earlier than the target date, to highlight the cell for Actual date (col B and/or D) in green.
• If there is no date input into Actual date field (i.e. Col B/D), and it is now 1 month away from the target date, to highlight as orange.
• If target date is more than 1 month away from the current as-of date, to leave the "Actual date" cell as white.

Would truly appreciate some help on this please. Thanks!!

 

[mrshl9898]

Hi,

Try:

Sub makeso()

Dim colnum As Long
Dim rownum As Long

rownum = 3
colnum = 1

Do Until Cells(rownum, colnum) = ""
    Do Until Cells(rownum, colnum) = ""
        If Cells(rownum, colnum) < Cells(rownum, colnum + 1) And Cells(rownum, colnum + 1) <> "" Then
            Cells(rownum, colnum + 1).Interior.Color = vbRed
        ElseIf Cells(rownum, colnum) > Cells(rownum, colnum + 1) And Cells(rownum, colnum + 1) <> "" Then
            Cells(rownum, colnum + 1).Interior.Color = vbGreen
        ElseIf Cells(rownum, colnum + 1) = "" And DateValue(Cells(rownum, colnum)) < DateAdd("m", 1, Now()) Then
            Cells(rownum, colnum + 1).Interior.Color = RGB(255, 180, 0)
        Else
            Cells(rownum, colnum + 1).Interior.Color = xlNone
        End If
    rownum = rownum + 1
    Loop
colnum = colnum + 2
rownum = 3
Loop

End Sub