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.
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