Entering wrong date ie 30-2-19 (30-Feb-2019) in txtDate.text it displays as 19-Feb-1930 instead of showing error msg

[SamDsouza]

Hello

Have an issue. when entering wrong date ie 30-2-19 (30-Feb-2019) in txtDate.text it displays as 19-Feb-1930. i dont know why.
Infact the below code has the msg of Invalid Date. but it by passes and shows wrong date altogether. The coding should not display any wrong dates

Option Explicit
Dim disableEvents As Boolean
Public dDate As Date

Private Sub txtDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   Worksheets("Sheet1").Columns(1).NumberFormat = "dd-mmm-yyyy"

    If txtDate.Value = vbNullString Then
       Exit Sub
    ElseIf Not IsDate(txtDate.Value) Then
       Cancel = True  
        MsgBox "Invalid date, please re-enter", vbCritical
        txtDate.Value = vbNullString
        txtDate.SetFocus
        Worksheets("Sheet1").Range("A2").Value = Format(CDate(txtDate.Value), "dd-mmm-yyyy")
     Exit Sub
End If
     dDate = DateSerial(Year(Date), Month(Date), Day(Date))
     txtDate.Value = Format(CDate(txtDate.Value), "dd-mmm-yyyy")
     Worksheets("Sheet1").Range("A2").Value = Format(CDate(txtDate.Value), "dd-mmm-yyyy")
End Sub

Private Sub UserForm_Initialize()
  Load userform1
  userform1.Show vbModeless
  With txtDate
     .Value = Worksheets("Sheet1").Range("A2").Value
     If .Value <> "" Then .Value = Format(.Value, "dd-mmm-yyyy")
  End With
 End Sub

SamD

 

[SamDsouza]

welshgasman

What I was trying to point out that eventually the 2 digit year test is going to fail. By that time you would likely be using new software. :D
Only you know your data, so if there is a chance of someone entering 01-01-99 then which century is that.? I would hazard a guess as to 1999. If you are putting dates in as 2099 how long do you think your software is going to run?


If it were me, I would create a dedicated function that would work out the correct date, allow for -,. & / delimiters etc and call in the AfterUpdate event of the controls.
Once written and tested, that should be it.

Thanks for your reply. I am not a champion as you guys. Still learning VBA for excel from the champion members here.
if you have dedicated function to share to set the correct date will appreciate it.

 

[welshgasman]

I don't. If you look at my signature, I am not an expert at Access either. However I google and find something and amend to suit. On this occasion that would not likely work. Perhaps you can glean something from here https://powerspreadsheets.com/vba-format-date/

I would break the problem down to small parts.

1. Find out what delimiter is being used with Instr function.
2. Split the string using the delimiter with the Split function.
3. Rebuild the date from it's respective parts.
4. Test for valid date for the rebuilt value.
5. Pass rebuilt value back to calling code.

Then post the working code back here in case it can help someone else. :D

 

[DanteAmor]

Thanks DanteAmor for your suggestion for adding another validation. Whats happening is i ve to compulsory add 10 digits
What is desired is Entering dates with the flexibility
as
1. 25-01-01 result as 25-Jan-2001
2. 2-3-14 result as 02-Mar-2014
3.02-03-2014 result as 02-Mar-2014
4. 02-3-14 result as 02-Mar-2014
5. 2-03-14 result as 02-Mar-2014

only if wrong date entered by mistake then Error Msg

You can use a control like Dtpicker or Monthview to get a date, and that way you do not have to validate correct dates.

 

[steve the fish]

Something like this makes 30-2-19 invalid but works on your other examples:

x = "30-2-19"
dateArr = Split(x, "-")
    
If dateArr(2) > 29 Then
    dateArr(2) = 19 * 100 + dateArr(2)
Else
    dateArr(2) = 20 * 100 + dateArr(2)
End If

If Month(DateSerial(dateArr(2), dateArr(1), dateArr(0))) <> Val(dateArr(1)) Then
    MsgBox "Invalid date entered"
    Exit Sub
Else
    myDate = DateSerial(dateArr(2), dateArr(1), dateArr(0))
End If

 

[SamDsouza]

Thank you guys for your wonderful help and suggestions.

SamD

 

[DanteAmor]

Thank you guys for your wonderful help and suggestions.

SamD

I'm glad to help you. Thanks for the feedback.