Comparing dates in two columns and highlighting the cell

Question

I'm 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'm 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 < 4 weeks, > 2 weeks of the start date the status is "Project remaining".

I have achieved the tree cases.

Case 4: there is a possibility that in some cases 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 case 4 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 Sub

Kindly help me to solve this issue.
Regards, Mikz

Why not simply add an if statment before zWeeks = (Cells(r, "E") - Cells(r, "D")) / 7 ? Something like if Cells(r, "E")="" then zText ="Project not started" else RestOfYourCode. — CMArg
– CMArg, Commented Jun 14, 2017 at 12:09

CMArg · Accepted Answer · 2017-06-14 19:40:59Z

0

Check:

Sub dateCompare()
zLastRow = Range("D" & Rows.Count).End(xlUp).Row    'last data row

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For r = 2 To zLastRow
    If IsEmpty(Cells(r, "E").Value) Then 'check if column is empty
        zColour = xlNone
        zText = " check dates"
    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"
        End Select
    End if

    Cells(r, "D").Interior.Color = zColour              'set cell background colour
    Cells(r, "F") = zText                               'set project status

Next
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

End Sub

edited Jun 14, 2017 at 19:40

CMArg

1,5973 gold badges14 silver badges32 bronze badges

answered Jun 14, 2017 at 12:09

Pablo notPicasso

3,1913 gold badges20 silver badges23 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

CMArg Over a year ago

@Komal Rohilla did code help? Feedback is always welcome.

Collectives™ on Stack Overflow

Comparing dates in two columns and highlighting the cell

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related