Not all dates are recognised by VBA

Question

I was writing a code that automatically checks if a cell (in column K) contains a date. It only should give an error if column K doesn't contain a date AND the date in column L is more than 30 days ago.

I've found out that my code works, but not for all dates. So I Debug.print and saw that he just ignores the fact that the if requirement isn't met. I've never experienced this.

This is the code (under it you'll find the debug)

Aantal = 0
i = 0
LastRow = 0
k = 0
LastRow = ThisWorkbook.Sheets("Acknowledgements follow up").Range("A1").End(xlDown).Row
'For i = 2 To LastRow
For i = 22214 To 22222
Debug.Print ActiveWorkbook.Sheets("Acknowledgements follow up").Range("L" & i).Value & "      " & ActiveWorkbook.Sheets("Acknowledgements follow up").Range("K" & i) + 30 & "      "; Date & vbCrLf
    If ActiveWorkbook.Sheets("Acknowledgements follow up").Range("L" & i).Value = "" And ActiveWorkbook.Sheets("Acknowledgements follow up").Range("K" & i) + 30 > Date Then
    Aantal = Aantal + 1
    MsgString = MsgString & i & " / "
    End If
Next i
If MsgString <> "" Then MsgString = Left(MsgString, Len(MsgString) - 3)

If Aantal > 1 Then
MsgBoxAnswer = MsgBox("There are " & Aantal & " dates missing in the acknowlegement sheet" & vbCrLf _
& "The missing dates are on rows " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
End If

If Aantal = 1 Then
MsgBoxAnswer = MsgBox("There is " & Aantal & " date missing in the acknowlegement sheet" & vbCrLf _
& "The missing date is on row " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
End If

I've found that cell 22217 contains a case where he should give an error. But he doesn't, the whole document contains more than 29000 rows. It gives me 58 errors but in reality there're way more.

This is the debug info I got (Check if date is empty (Column L) / Column K + 30 days / today)

05-08-13 01-09-13 06-11-17

05-08-13 01-09-13 06-11-17

05-08-13 01-09-13 06-11-17

 01-09-13      06-11-17

05-08-13 04-09-13 06-11-17

06-08-13 04-09-13 06-11-17

05-08-13 04-09-13 06-11-17

05-08-13 04-09-13 06-11-17

30-12-13 04-09-13 06-11-17

As you can see it recognises that row 22217 is empty and the date is longer than 30 days. So it should be triggered. I found out that it is this line that doesn't work properly: ActiveWorkbook.Sheets("Acknowledgements follow up").Range("K" & i) + 30 > Date

Any ideas? Thanks! KawaRu

Answer 1

This works on my system for testing dates older than 30 days:

Option Explicit ' Always start every VBA file with this
Option Base 0   ' Not as important, but I use it as a reminder to myself

Public Sub KawaRu()
    Dim CL As Long, CK As Long  ' Column numbers for L, K
    CL = AscW("L") - AscW("A") + 1
    CK = AscW("K") - AscW("A") + 1

    ' Always Dim your variables, and use Option Explicit
    Dim aantal As Long, i As Long, LastRow As Long, k As Long
    Dim MsgString As String
    aantal = 0
    i = 0
    k = 0

    ' Avoid repeating references to objects.  Instead, save them in a variable.
    Dim sh As Worksheet
    Set sh = ActiveWorkbook.Sheets("Acknowledgements follow up")

    LastRow = sh.Range("A1").End(xlDown).Row

    For i = 1 To LastRow
        Debug.Print sh.Range("L" & i).Value, sh.Range("K" & i) + 30, Date
        ' Use Cells() for speed when you're in a loop.
        If sh.Cells(i, CL).Value = "" And _
                sh.Cells(i, CK) < (Date - 30) Then
              ' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ older than 30 days
            aantal = aantal + 1
            MsgString = MsgString & i & " / "
        End If
    Next i

    Debug.Print aantal
    If MsgString <> "" Then MsgString = Left(MsgString, Len(MsgString) - 3)

    Dim MsgBoxAnswer As VbMsgBoxResult

    If aantal > 1 Then
        MsgBoxAnswer = MsgBox("There are " & aantal & " dates missing in the acknowlegement sheet" & vbCrLf _
            & "The missing dates are on rows " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
    End If

    If aantal = 1 Then
        MsgBoxAnswer = MsgBox("There is " & aantal & " date missing in the acknowlegement sheet" & vbCrLf _
        & "The missing date is on row " & MsgString, vbOKOnly + vbExclamation, "Missing dates")
    End If

End Sub

My test data was:

col. A       K              L             M
x            5/8/2013       1/9/2013      6/11/2017
x            1/9/2013                     6/11/2017
x            1/9/2013                     6/11/2017
x            11/1/2017                    6/11/2017

The result I get is:

There are 2 dates missing in the acknowledgement sheet
The missing dates are on rows 2/ 3

Edit

The algorithmic problem was the date test. Kx + 30 > Date tests whether the value in column K is within the last 30 days, not older than 30 days. In the code above, Kx < (Date - 30) tests for older than 30 days. (Kx + 30) < Date (less than) would do the same.

An improvement on the code above would be to rename CK and CL. Instead of naming them after their locations, name them after their meanings. E.g., COL_ACK_RECEIVED or something. That will make it easier to understand your code when you come back to it later.

Edit 2

• As @HarassedDad noted in a comment, be careful of d/m/y vs. m/d/y and other date-format issues.
• "Older than 30 days" might mean < Date - 30 or <= Date - 30, depending on your requirements.
• For future readers who may be looking at adapting this, remember that "30 days ago" and "last month" are very different!
• This answer regarding Range.Value is a good one. I will add that using CStr() or other converter functions is a good practice, since Range.Value returns a Variant.
• This question and this question, and their answers, are good reading re. why = "" might not always match a cell that appears to be empty.