Date Automatically Reversing VBA Excel - vba

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.

Answer 1

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

Answer 2

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: