Forum Discussion
comparing dates in 2-columns and highlighting the cell
Hi Everyone,
I am comparing the two Dates in the two columns (D and E).
The Dates in column D are source Dates and the Dates in column E are Start date of the Project.
I am calculating the difference in two Dates as weeks and pasting the result in the column F and highlighting it accordingly.
I have 4 cases with me.
Case 1: if the sourcing date is > 4 weeks of start date then the Status is Project delayed.
Case 2: If the source date is < 2 weeks of the start date then the Status is Project on time
case 3: If the source date is <4weeks, >2 weeks of the start date the Status is Project remaning.
I have achieved the three cases.
Case 4: there is a possiblity that in somecases the column E does not have any date and it is empty. in this Situation, I would like to have an if case, that says Project not started.
I tried it as Null but, i could not figure out, why this case4 was not working.
Sub dateCompare()
zLastRow = Range("D" & Rows.Count).End(xlUp).Row 'last data row
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For r = 2 To zLastRow
zWeeks = (Cells(r, "E") - Cells(r, "D")) / 7 'date difference in weeks
Select Case zWeeks
Case Is > 4 'later than 4 weeks
zColour = vbRed
zText = "Project delayed " & Int(zWeeks) & " weeks"
Case 2 To 4 'between 2 and 4 weeks
zColour = vbYellow
zText = "Project ongoing"
Case Is < 2 'less than 2 weeks
zColour = vbGreen
zText = "Project On-Time"
Case Else 'in case of duff data..
zColour = xlNone
zText = " check dates"
End Select
Cells(r, "D").Interior.Color = zColour 'set cell background colour
Cells(r, "F") = zText 'set project status
Next
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End SubKindly help me to solve this issue.
Regards,
Mikz
9 Replies
- I am wondering however, why are you using VBA and not a formula combined with some conditional formatting?
Formula and conditional formatting will do the trick easier than VBA.
Insert this in Column F:
=WEEKNUM(E4-D4)
and in Column H (Status), insert
=IF(AND(E4<>"",D4<>""),IF(F4>4,"Project Delayed",IF(F4<2,"Project On Time",IF(AND(F4<4,F4>2),"Project Ongoing"))),"Project not Started")
..Then you can use condition formatting for the highlights.
- I think you meant =WEEKNUM(E4)-WEEKNUM(D4). Moreover, if the year changes you run into trouble, perhaps a simple =INT((E4-D4)/7) works better?
Something like:
Sub dateCompare() zLastRow = Range("D" & Rows.Count).End(xlUp).Row 'last data row '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For r = 2 To zLastRow If Cells(r, "E").Value = "" Then zColour = vbRed zText = "Project not started" Else zWeeks = (Cells(r, "E") - Cells(r, "D")) / 7 'date difference in weeks Select Case zWeeks Case Is > 4 'later than 4 weeks zColour = vbRed zText = "Project delayed " & Int(zWeeks) & " weeks" Case 2 To 4 'between 2 and 4 weeks zColour = vbYellow zText = "Project ongoing" Case Is < 2 'less than 2 weeks zColour = vbGreen zText = "Project On-Time" Case Else 'in case of duff data.. zColour = xlNone zText = " check dates" End Select Cells(r, "D").Interior.Color = zColour 'set cell background colour Cells(r, "F") = zText 'set project status End If Next '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ End Sub
