Date Automatically Reversing VBA Excel

Question

So, I'm having some problems with dates that are reversing themselves in VBA when assigned to a Date variable. It's simpler than it sounds, but it's really bugging me.

Code:

Dim InsertedDate as Date

On Error Resume Next

InsertedDate = Me.BoxDate.Value

If InsertedDate = 0 Then

     'Do Something

Else

     'Do Something Different

End If

So let's assume that user types a value like

12/18/2017

I'm brazilian, so that means the user typed the 12th day of the 18th month. Since there's no 18th month in the year, the user shouldn't be able to type that date and InsertedDate should be equal to 0, right? Or not? I mean, I'm not really sure how Excel work dates.

Anyway, what happens is: Excel automatically reverses the date to

18/12/2017       'InsertedDate Value

instead of InsertedDate being

12/18/2017       'InsertedDate Value

And the code goes to 'Do Something Different. So, how do I solve this? Notice that I haven't assigned the variable value to anything. The process of reversion happens automatically when assigning the value to the variable. I've already tried

Format(InsertedDate, "dd/mm/yyyy")    'Did not work

and

InsertedDate = CDate(Me.BoxDate.Value)  'Did not work

and I tried converting the values in other variables and stuff. So, I'm lost. If anyone could help me, I'd be extremely grateful. Thank you in advance.

Are the international settings on your computer set for dd/mm/yyyy ? — braX, Sep 27 '17 at 18:25
I don't know. How can I check this? I'm new at VBA so I don't really understand how it works and how it relates to the OS. — Aurélio S. C. C. Póvoa, Sep 27 '17 at 18:31
https://support.office.com/en-us/article/Change-your-date-format-c2557873-d161-4ad6-ae67-32b45c4d8484 — braX, Sep 27 '17 at 18:34
Use `Format(InsertedDate, "mm/dd/yyyy")` and it will work if I recall correctly. — Moacir, Sep 27 '17 at 18:41
As long as Excel understands dates as being dates, you don't need to worry about what they look like — Mathieu Guindon, Sep 27 '17 at 18:53
@Moacir I already tried that, didn't work. But thanks anyway. — Aurélio S. C. C. Póvoa, Sep 27 '17 at 19:07
@Mat'sMug In fact, I really need Excel to understand the date that user typed because of the IF statement that follows. If the date is wrong, the IF statement will proceed to ELSE and that doesn't work for me. But thanks for the reply! — Aurélio S. C. C. Póvoa, Sep 27 '17 at 19:08

danieltakeshi · Answer 1 · 2017-10-04T17:59:08.593

I just could think of a way to make it on the hardest way, which is extracting each element and comparing.

diamesano = Me.BoxDate.Value
'diamesano = "12/18/2017"

    dia = CLng(Left(diamesano, 2))
    mes = CLng(Left(Mid(diamesano, 4), 2))
    ano = CLng(Right(diamesano, 4)) 'Assuming year with 4 digits, otherwise some tweaks are necessary
    Debug.Print "day: " & dia & " month: " & mes & " Year: " & ano

    date_error = 0
    If mes >= 1 And mes <= 12 Then 'Check if month is ok
        mesAno = (Right(diamesano, 7))
        DiasNoMes = Day(DateSerial(Year(mesAno), Month(mesAno) + 1, 0))
        If dia >= 1 And dia <= DiasNoMes Then 'Check the amount of days on this month and if is in range
            Debug.Print "OK"
           'Do something because the Date is valid!
        Else
            date_error = 1
        End If
    Else
            date_error = 1
    End If

If date_error = 1 Then
         Debug.Print "NOK"
        'Date is invalid =P
End If

Tried to use IsDate() function, but it reversed the date, even if formatting "dd/mm/yyyy" is used before.

Edit:

UDF to split the date

If the user input another format as "d/m/yy", the code below will correct. In which the function EXTRACTELEMENT will split the String by / and get the elements.

Function EXTRACTELEMENT(Txt As String, n, Separator As String) As String
 On Error GoTo ErrHandler:
 EXTRACTELEMENT = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1)
 Exit Function
ErrHandler:
    ' error handling code
    MsgBox "ERROR: Verify if the data exists, example if the separator is correct."
    On Error GoTo 0
End Function

So to use the UDF, if the date is diamesano = "2/5/14"

the day will be EXTRACTELEMENT(CStr(diamesano), 1, "/") where 1 is the 1st element that is the value 2
the month will be EXTRACTELEMENT(CStr(diamesano), 2, "/") where 2 is the 2nd element that is the value 5
the year will be EXTRACTELEMENT(CStr(diamesano), 3, "/") where 3 is the 3rd element that is the value 14

Code to use the UDF and check dates

And the code changes to:

diamesano = "12/18/2017"

    dia = CLng(EXTRACTELEMENT(CStr(diamesano), 1, "/"))
    mes = CLng(EXTRACTELEMENT(CStr(diamesano), 2, "/"))
    ano = CLng(EXTRACTELEMENT(CStr(diamesano), 3, "/"))
    Debug.Print "day: " & dia & " month: " & mes & " Year: " & ano

    date_error = 0
    If mes >= 1 And mes <= 12 Then 'Check if month is ok
        mesAno = mes & "/" & ano
        DiasNoMes = Day(DateSerial(Year(mesAno), Month(mesAno) + 1, 0))
        If dia >= 1 And dia <= DiasNoMes Then 'Check the amount of days on this month and if is in range
            Debug.Print "OK"
           'Do something because the Date is valid!
        Else
           date_error = 1
        End If
    Else
        date_error = 1
    End If

    If date_error = 1 Then
             Debug.Print "NOK"
            'Date is invalid =P
    End If

Create UDF to check if the Date is right

Function IsDateRight(diamesano) As String
    On Error GoTo ErrHandler:
    dia = CLng(Split(Application.Trim(Mid(CStr(diamesano), 1)), "/")(0))
    mes = CLng(Split(Application.Trim(Mid(CStr(diamesano), 1)), "/")(1))
    ano = CLng(Split(Application.Trim(Mid(CStr(diamesano), 1)), "/")(2))

    'Debug.Print "day: " & dia & " month: " & mes & " Year: " & ano

    date_error = 0
    If mes >= 1 And mes <= 12 Then 'Check if month is ok
        mesAno = mes & "/" & ano
        DiasNoMes = Day(DateSerial(Year(mesAno), Month(mesAno) + 1, 0))
        If dia >= 1 And dia <= DiasNoMes Then 'Check the amount of days on this month and if is in range
            IsDateRight = "Yes"
           'Do something because the Date is valid!
        Else
           date_error = 1
        End If
    Else
        date_error = 1
    End If

    If date_error = 1 Then
             IsDateRight = "No"
            'Date is invalid =P
    End If
    Exit Function
    ErrHandler:
    ' error handling code
    MsgBox "ERROR: Verify if the data exists, example if the separator is correct."
    On Error GoTo 0
End Function

And a test:

In cases where user might use use either date formats (m/d/yy or d/m/yy) it appears to me this function will not be able to recognize that. You might want to test for local date settings. — Victor K, Sep 27 '17 at 19:06
Thanks, man! I really appreciate your help! I'll try your code and I'll get back to you! — Aurélio S. C. C. Póvoa, Sep 27 '17 at 19:35

Victor K · Accepted Answer · 2017-09-27T20:04:06.880

If you choose data type as Date it will automatically convert dates to american format.
My suggestion is to check the date format of the user and assume he uses the same (and it is not the safest assumption):

If Application.International(xlMDY) then
     InsertedDate = Me.BoxDate.Value
Else:
     Arr = Split(Me.BoxDate.Value,"/")
     InsertedDate = DateSerial(Arr(2),Arr(1),Arr(0))
End if

But it assumes that user has used "/" as a delimite - and there could be a lot of other scenarios. You can use a date picker instead or a function that will validate the date.

EDIT: Actually here is a variation of function I use and its implementation in your code:

Sub TestDate()
If ConformDate(Me.BoxDate.Value) = "" Then
    MsgBox "Invalid Date!"
Else
    MsgBox "" & ConformDate(Me.BoxDate.Value) & " is a valid date"
End If
End Sub

Function ConformDate(DataToTransform As String) As String

Dim DTT         As String
Dim delim       As String
Dim i           As Integer
DTT = DataToTransform

DTT = Trim(DTT)
With CreateObject("VBScript.RegExp")
    .Pattern = "\s+"
    .Global = True
    DTT = .Replace(DTT, " ")
End With
Select Case True
   Case (DTT Like "*/*/*")
        delim = "/"
   Case (DTT Like "*-*-*")
        delim = "-"
   Case (DTT Like "*.*.*")
        delim = "."
   Case (DTT Like "* * *")
        delim = " "
   Case Else
        ConformDate = ""
        Exit Function
End Select
Arr = Split(DTT, delim)
If UBound(Arr) < 2 Then
    ConformDate = ""
    Exit Function
End If
Dim Arrm(2) As String
If Application.International(xlMDY) Then
    Arrm(0) = Arr(0)
    Arrm(1) = Arr(1)
    Arrm(2) = Arr(2)
Else
    Arrm(0) = Arr(1)
    Arrm(1) = Arr(0)
    Arrm(2) = Arr(2)
End If
For i = LBound(Arrm) To UBound(Arrm)
    If Not IsNumeric(Arrm(i)) Then
        ConformDate = ""
        Exit Function
    End If
Select Case i
        Case 0
            ' Month
            If Len(Arrm(i)) < 1 Or Len(Arrm(i)) > 2 Then
                ConformDate = ""
                Exit Function
            End If
            If Left(Arrm(i), 1) = "0" And Len(Arrm(i)) = 1 Then
                ConformDate = ""
                Exit Function
            End If
            If Left(Arrm(i), 1) = "0" Then Arr(i) = Right(Arrm(i), 1)
            If Arrm(i) > 12 Then
                ConformDate = ""
                Exit Function
            End If
        Case 1
            ' Day
            If Len(Arrm(i)) < 1 Or Len(Arrm(i)) > 2 Then
                ConformDate = ""
                Exit Function
            End If

            If Left(Arrm(i), 1) = "0" And Len(Arrm(i)) = 1 Then
                ConformDate = ""
                Exit Function
            End If
            If Left(Arrm(i), 1) = "0" Then Arrm(i) = Right(Arrm(i), 1)
                If Arrm(i) > 31 Then
                ConformDate = ""
                Exit Function
            End If
            Case 2
            ' Year
            If Not (Len(Arrm(i)) = 2 Or Len(Arrm(i)) = 4) Then
                ConformDate = ""
                Exit Function
            End If
            If Len(Arrm(i)) = 2 Then Arrm(i) = Left(Year(Date), 2) & CStr(Arrm(i))
 End Select
Next

If Application.International(xlMDY) Then
    ConformDate = Format((DateSerial(CInt(Arrm(2)), CInt(Arrm(0)), CInt(Arrm(1)))), "dd/mm/yyyy")
Else
     ConformDate = Format((DateSerial(CInt(Arrm(2)), CInt(Arrm(1)), CInt(Arrm(0)))), "dd/mm/yyyy")
End If
End Function

I tried this code and seemed like a solution to me, but Excel returned me a InsertedDate = 12/06/2018. The code goes to ELSE because Application.International(xlMDY) is false and the DateSerial assigns 12/06/2018 to InsertedDate. Maybe we are missing something, because the code looks perfect for what I want! — Aurélio S. C. C. Póvoa, Sep 27 '17 at 19:20
@AurélioS.C.C.Póvoa I am working on an edit right now. Check in a few minutes. Also can you tell me what was entered as well as what was returned? — Victor K, Sep 27 '17 at 19:23
Assuming the user entered 12/18/2017, the value assigned to the variable InsertedDate was 12/06/2018. I'll wait. Thanks! — Aurélio S. C. C. Póvoa, Sep 27 '17 at 19:29
Yes, it is the same of excel formula `=DATE(2017;18;12)`, which means month 12 (1 year) + month 6, so you go to 2018 — danieltakeshi, Sep 27 '17 at 19:31
@danieltakeshi I am still testing it as I was modifying it from existing UDF — Victor K, Sep 27 '17 at 19:52
So, I was thinking. The result is a valid date (12/06/2018) although it doesn't work for me, because what I want is that VBA code to inform me that the date inserted is not valid. That's what's inside the IF statement. The ELSE statement is for valid dates. If the user types 12/18/2017 I want the code to print: Invalid date! But if it the InsertedDate variable holds 12/06/2018 like it happened, the code will consider it a valid date and proceed to the ELSE statement. I was looking at the DateSerial Function online and it really must be the way. — Aurélio S. C. C. Póvoa, Sep 27 '17 at 19:52
I did some more adjustments in the end to account for the local formatting. — Victor K, Sep 27 '17 at 19:58
It worked! I really appreciate it, man! Thank you so much! Although I just tried inserting 30/02/2017 and it considered the date valid! Hahahahaha! Well, that's not a real problem, I think I can handle it now, based on your code! I'll study it so I can use it some similar codes I have. Thanks again! — Aurélio S. C. C. Póvoa, Sep 27 '17 at 20:03
You could just change from 31, to the line of code i used as `DiasNoMes` which is DaysInMonth, because if you enter day 31 in February, it should return as invalid. — danieltakeshi, Sep 27 '17 at 20:05
@AurélioS.C.C.Póvoa yes, it has issues with 31-30-28 days, I'll work on that one day :) . Thank you for accepting the answer — Victor K, Sep 27 '17 at 20:06

Date Automatically Reversing VBA Excel

2 Answers2

Edit:

UDF to split the date

Code to use the UDF and check dates

Create UDF to check if the Date is right

Linked