CODEWITHSUNDEEP
vbaexceldate
Mikz
Mikz

Reputation: 591

Comparing the dates and highlighting the result

I am comparing two Dates in columns D and E of My worksheet.

Column D contains the source Date and column E contains the Start date.

I have 4 cases to compare the date.

Case 1. If the sorce date is < 2 weeks of start date, then print Project on time.

case 2: if the source date is > 4 weeks of start date , then print Project delay.

case 3: if the source date is between 2 to 4 weeks of start date, then print Project is remaning.

I have derived the code for the above cases, Now

Case 4: not everytime the column E is filled with date, they are empty sometimes.

So, How would i add a null Statement here. I tried adding an null Statement, but it failed.

Below is the code. 

Sub dateCompare()

zLastRow = Range("D" & Rows.Count).End(xlUp).Row

For r = 2 To zLastRow

    zWeeks = (Cells(r, "E") - Cells(r, "D")) / 7
    Select Case zWeeks
        Case Is > 4
            zcolour = vbRed
            Ztext = "Project Delayed " & Int(zWeeks) & " weeks"
        Case 2 To 4
            zcolour = vbYellow
            Ztext = "Project Remaining"
        Case Is < 2
            zcolour = vbGreen
            Ztext = "Project On-Time"
        Case Else
            zcolour = xlNone
            Ztext = " Check Status"
    End Select

    Cells(r, "F").Interior.Color = zcolour
    Cells(r, "F") = Ztext            
Next

End Sub

Upvotes: 1

Views: 38

Answers (1)

Shai Rado
Shai Rado

Reputation: 33692

Before calculating zWeeks check the column "E" is not empty, with If Len(Trim(Cells(r, "E"))) = 0 Then. Afterwards, use your Select Case.

Also, you can use DateDiff function, with the first parameter being "ww" (weeks), to calculate directly the difference in weeks between the dats in column "E" amd column "D".

Code

Option Explicit

Sub dateCompare()

Dim r As Long, zLastRow As Long
Dim zWeeks As Double, zcolour As Long
Dim Ztext  As String

zLastRow = Cells(Rows.Count, "D").End(xlUp).Row

For r = 2 To zLastRow
    If Len(Trim(Cells(r, "E"))) = 0 Then ' column "E" is empty
        ' do something....
    Else ' column "E" is not empty
        zWeeks = DateDiff("ww", Cells(r, "D"), Cells(r, "E"))

        Select Case zWeeks
            Case Is > 4
                zcolour = vbRed
                Ztext = "Project Delayed " & Int(zWeeks) & " weeks"
            Case 2 To 4
                zcolour = vbYellow
                Ztext = "Project Remaining"
            Case Is < 2
                zcolour = vbGreen
                Ztext = "Project On-Time"
            Case Else
                zcolour = xlNone
                Ztext = " Check Status"
        End Select

        Cells(r, "F").Interior.Color = zcolour
        Cells(r, "F") = Ztext
    End If
Next r

End Sub

Upvotes: 2

Related Questions