Date entry check

[Magic_Doctor]

Hello,

To control date entries, I wrote this:
- In a standard module:

Function VérifieEntréeDate(cel As Variant) As Boolean

    VérifieEntréeDate = IsDate(cel.Text) And Format(cel.Text, "dd/mm/yyyy") = cel.Text
    
End Function

It seems to be working well. On the other hand, if I enter, for example, 12320 (which has nothing to do with 12/3/20), the error is not recognized and it returns me, of course, 23/09/1933.
I'm sorry, but I use the Latin notation for dates (France / Spain / Italy ...).
To try to solve the problem, I added this:
- In the sheet module:

Option Explicit
Public remember As Date
----------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [MaDate]) Is Nothing Then
        If VérifieEntréeDate([MaDate]) = True Then   'the entry is valid
            [Vérif] = True
            [MaDateBis] = [MaDate]                   'the cell named "MaDateBis" retrieves the new valid entered date
        Else                                         'we brought in anything
            [Vérif] = False
            [MaDate] = remember                      'the cell takes the last valid date
        End If
        [Format] = TypeName([MaDate].Value)          'format of the cell where the date is entered
'        Target.Select
    End If
End Sub
----------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [MaDate]) Is Nothing Then
        remember = [MaDateBis]               'as soon as you select the cell named "MaDate", the "remember" variable retrieves the value of the last valid entry, in case ...
        Target.NumberFormat = "General"      'we exit from the "Date" format for a possible entry
        [Format] = TypeName([MaDate].Value)  'format of the cell where the date is entered
    End If
End Sub

It works well, however there is a problem, I would say crippling, when you just select the cell where you enter the date. Once selected, you have to enter something, otherwise you are left with a result that is at least disconcerting for those who are not champions of mental arithmetic. The last problem is, therefore, how to make so that, when selecting said cell, it keeps an intelligible result? But maybe that's not possible ...

 

[Akuini]

What date format exactly do you want to enter?
Here's is an example if the date format must be using "/" like 13/4/2020:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
         If checkDate(Target) Then
            MsgBox "Correct date format"
         Else
'            Application.EnableEvents = False
            MsgBox "Incorrect date format"
'            Application.EnableEvents = True

         End If
    End If

End Sub


Function checkDate(c As Range) As Boolean
     checkDate = UBound(Split(c.Text, "/")) = 2 And IsDate(c)
End Function

 

[Magic_Doctor]

Good morning Akuini,

I want to enter the date in the format "dd/mm/yyyy".
There is still a problem. If, unfortunately, someone entered the date 13/4/2020 in the form 1342020, the function will not catch the error and will return 28/04/5574, which has absolutely nothing to do with 13/04/2020. Can we catch this type of error? Here is the key to the problem of this discussion.

 

[Akuini]

If, unfortunately, someone entered the date 13/4/2020 in the form 1342020, the function will not catch the error and will return 28/04/5574

Ah, you're right. It's more complicated than I thought & I can't find a good solution.
How about just checking if the date entered falls between 2 specific years.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
    Dim flag
    flag = False
         If IsDate(Target) Then
            If Year(Target) >= 1980 And Year(Target) <= 2040 Then flag = True
         End If
            
        If Not Target = Empty And flag = False Then
            MsgBox "Incorrect date format"
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
        End If
         
    End If

End Sub

 

[Magic_Doctor]

Indeed, it is more complicated than expected.
I have made some progress in trying to resolve the problem, but there is still a problem.
Unfortunately, not being able to transmit a file, I explain, step by step, my approach.

On the sheet there are only 2 cells (named):
- The "MyDate" cell where you enter a date in the form "dd/mm/yyyy"
- The "MyDateBis" cell which retrieves the last valid date entered

In a standard module, is your function:

Function CheckDate(c As Range) As Boolean
'Checks if the entry is a date in the form "dd/mm/yyyy"
'Akuini

    CheckDate = UBound(Split(c.Text, "/")) = 2 And IsDate(c)
  
End Function

In the sheet module, I wrote this:

Option Explicit

Public remember As Date
Public StringDate$
---------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, [MyDate]) Is Nothing Then
        If CheckDate([MyDate]) = True Then  'the data is valid
            [MyDateBis] = CStr([MyDate])    'the cell named "MyDateBis" retrieves the new valid entered date
            StringDate = CStr([MyDateBis])  'the date is transformed into a character string
        Else                                'we brought in anything
            [MyDate] = remember             'the cell takes the last valid date
        End If
        Target.Select
    End If

End Sub
---------------------------------------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Target, [MyDate]) Is Nothing Then
        remember = [MyDateBis]           'as soon as you select the cell named "MyDate", the "remember" variable retrieves the value of the last valid entry, in case ...
        Target.NumberFormat = "General"  'we exit from the "Date" format for a possible entry
        Target = StringDate              'the cell displays a date transformed into a character string
    End If

End Sub

It works fine, except when the day ("dd") is <= 12.
For example, I enter the cell "MyDate": "3/12/20"
In the cell "MyDateBis" does not appear "12/03/20", but "03/12/2020"
And if, just after, I enter the "MyDate" cell, for example, "23822", it is not the last valid date that appears in the "MyDate" cell but "03/21/1965".

It's curious to see that such a simple problem is so complicated to solve ...

 

[Akuini]

Sorry, this approach is too complicated for me.
How about using data validation?
Here's an example:
excel-only-allow-date-in-cell

note: but my knowledge of Excel formula is very basic, so don't ask me about the formula.

 

[Magic_Doctor]

There is a little progress. The last problem to be solved is when the day is <= 12. Suppose the displayed date (dd/mm/yyyy) is 06/03/2021. If you enter, for example, "whjw", the date 06/03/2021 remains displayed. On the other hand, if we enter, for example, 3821 (we wanted to enter 03/08/2021), appears 06/17/1910, instead of 06/03/2021. Problem that does not occur if the day is > 12.

In a standard module:

Option Explicit
-----------------------------------------------------------------------

Function CheckDate(c As Range) As Boolean
'Checks if the entry is a date in the form "dd/mm/yyyy"
'Akuini

    CheckDate = UBound(Split(c.Text, "/")) = 2 And IsDate(c)
  
End Function
-----------------------------------------------------------------------

Sub CorrectDate()
'Check if the day is > 12 or not

Dim CheckDayDate As Boolean

    CheckDayDate = IIf(Day([MyDateBis]) > 12, False, True)
    [C3] = CheckDayDate                                                             'just for see

    If CheckDayDate Then                                                            'day <= 12
        [MyDateBis] = Month([MyDate]) & "/" & Day([MyDate]) & "/" & Year([MyDate])  'day/month inversion
    Else                                                                            'day > 12
        [MyDateBis] = [MyDate]
    End If

End Sub

In the sheet module:

Option Explicit

Public remember As Date
Public StringDate$
-------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, [MyDate]) Is Nothing Then
        If CheckDate([MyDate]) = True Then  'the data is valid
            [MyDateBis] = CStr([MyDate])    'the cell named "MyDateBis" retrieves the new valid entered date
            StringDate = CStr([MyDateBis])  'the date is transformed into a character string
            CorrectDate
        Else                                'we brought in anything
            [MyDate] = remember             'the cell takes the last valid date
        End If
        Target.Select
    End If

End Sub
-------------------------------------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Target, [MyDate]) Is Nothing Then
        remember = [MyDateBis]           'as soon as you select the cell named "MyDate", the "remember" variable retrieves the value of the last valid entry, in case ...
        Target.NumberFormat = "General"  'we exit from the "Date" format for a possible entry
        Target = StringDate              'the cell displays a date transformed into a character string
    End If

End Sub

 

[Akuini]

1. Did you try the data validation I suggested?
2. Another method I can't think of:
double-click the cell > a userform shows up > enter date in a textbox (a macro will verify the date format) > hit a button to send the date to the cell