Check Date Format Input into Excel Column with VBA code ("DD/MM/YYYY" format)

[inoka]

Hi,

I would like to check the format of dates entered or pasted into a Excel Spreadsheet column with VBA code.
The date format must be DD/MM/YYYY. A message box should appear if any invalid data is found and the option to clear the individually cell with the bad entry or cancel the entire input provided.

This issue same as the following question. But, onlty difference is, in here date format should be "DD/MM/YYYY".

https://www.excelforum.com/excel-pro...-vba-code.html

Could you please provide the VBA code for me to test?

[ranman256]

Try this:

usage: ValidateDate ActiveCell.Text

'DD/MM/YYYY" format
Function ValidateDate(ByVal pvDateCode) As Boolean

    Dim D As Integer
    Dim LeapYear As Boolean
    Dim M As Integer
    Dim Result As Boolean
    Dim Y As Integer, i As Integer
    Dim sDte As String, sPart As String

    'If Not IsNumeric(pvDateCode) Then Exit Function
        
sDte = Format(pvDateCode, "dd/mm/yyyy")
i = InStr(pvDateCode, "/")
If i = 0 Then
   MsgBox "Invalid date"
Else
  D = Left(sDte, i - 1)
  sPart = Mid(sDte, i + 1)
  i = InStr(sPart, "/")
  M = Left(sPart, i - 1)
  
  i = InStrRev(sDte, "/")
  Y = Mid(sDte, i + 1)
End If

If M > 12 Then Result = False: GoTo endit
If Y < 1900 Then Result = False: GoTo endit
            
            LeapYear = (Y Mod 100 <> 0 And Y Mod 4 = 0) Or (Y Mod 400 = 0)
        
            Select Case M
                Case 1, 3, 5, 7, 8, 10, 12
                    If D >= 1 And D <= 31 Then Result = True
                Case 2
                    If LeapYear Then
                        If D >= 1 And D <= 29 Then Result = True
                    Else
                        If D >= 1 And D <= 28 Then Result = True
                    End If
                Case 4, 6, 9, 11
                    If D >= 1 And D <= 30 Then Result = True
            End Select
endit:
If Not Result Then MsgBox "Format: dd/mm/yyyy", , "Invalid Date"
        ValidateDate = Result
End Function

[inoka]

Thank you. Could you please send me the excel file.

[inoka]

It is shown a Run-time error '13'. Could you please send me excel file.

[inoka]

If I add date as "2019-09-12", it is shown a debug error. Could you please help me to find this error.
Also, if I add "10/25/2017", it is not validated. I need to validate while entering any incorrect format. Thanks.

[ikboy]

try:

Sub zz()
Dim s$
With CreateObject("vbscript.regexp")
    .Pattern = "(([12][0-9])|(3[01])|(0?[1-9]))/((1[0-2])|(0?[1-9]))/(\d{4}|\d{2})"
    s = InputBox("DD/MM/YYYY", "Check Date Format")
    If .test(s) Then
        MsgBox "OK"
    Else
        MsgBox "It is not validated"
    End If
End With
End Sub

[inoka]

Hi ikboy,
Thanks for your reply. but, it's not working. could you please help me to find the solution by improving initial code. It's working with some scenarios. but, it's not validated with "2019/09/21", "2019-08-23", "2/08/018" and "2/9/2018".

[jindon]

"2019/09/21", "2019-08-23", "2/08/018" and "2/9/2018".

Sub test()
    Dim e
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(0?[1-9]|[12][0-9]|3[01])([ /-])(0?[1-9]|1[0-2])\2\d{4}$"
        For Each e In Array("2019/02/28", "2019-08-23", "2/08/018", "2/9/2018")
            MsgBox CBool(.test(e) * IsDate(e)), , e
        Next
    End With
End Sub

[inoka]

Thanks jindon.
But, It's not fulfilled my requirement. I want following validations.
* Date format should be in "DD/MM/YYYY"
* "DD-MM-YYYY" should be invalid format
* "DD.MM.YYYY" should be invalid format
* "D/M/YYY" should be invalid format
* "YYYY/MM/DD" should be invalid format
* "YYY/MM/DD" should be invalid format
* "YYYY-MM-DD" should be invalid format
* "YYYY.MM.DD" should be invalid format

Should be accepted only the "DD/MM/YYYY" format as valid format. all other formats should be rejected. Also, date and month should be validated for number of days "30" and "31". In addition to that February month only for "28" and "29" days.

If you could enhance following code, it will be easy. because, already it has validated some validations. Thank you so much for your great help.

Function ValidateDate(ByVal pvDateCode) As Boolean

Dim D As Integer
Dim LeapYear As Boolean
Dim M As Integer
Dim Result As Boolean
Dim Y As Integer, i As Integer
Dim sDte As String, sPart As String

'If Not IsNumeric(pvDateCode) Then Exit Function

sDte = Format(pvDateCode, "dd/mm/yyyy")
i = InStr(pvDateCode, "/")
If i = 0 Then
MsgBox "Invalid date"
Else
D = Left(sDte, i - 1)
sPart = Mid(sDte, i + 1)
i = InStr(sPart, "/")
M = Left(sPart, i - 1)

i = InStrRev(sDte, "/")
Y = Mid(sDte, i + 1)
End If

If M > 12 Then Result = False: GoTo endit
If Y < 1900 Then Result = False: GoTo endit

LeapYear = (Y Mod 100 <> 0 And Y Mod 4 = 0) Or (Y Mod 400 = 0)

Select Case M
Case 1, 3, 5, 7, 8, 10, 12
If D >= 1 And D <= 31 Then Result = True
Case 2
If LeapYear Then
If D >= 1 And D <= 29 Then Result = True
Else
If D >= 1 And D <= 28 Then Result = True
End If
Case 4, 6, 9, 11
If D >= 1 And D <= 30 Then Result = True
End Select
'endit:
'If Not Result Then MsgBox "Format: dd/mm/yyyy"
'ValidateDate = Result

endit:
ValidateDate = Result

End Function

[jindon]

Then change the pattern

Sub test()
    Dim e
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(0[1-9]|[12][0-9]|3[01])/(0[1-9]|1[0-2])/\d{4}$"
        For Each e In Array("10/02/2017", "10.02.2017", "2/8/2017", "2/9/2018", "02/01/2017")
            MsgBox IIf(.test(e) * IsDate(e), "Valid ", "Invalid ") & "date", , e
        Next
    End With
End Sub

[inoka]

Thanks jindon.

It's not working. could you please send me excel file.

[jindon]

It's not working.

This doesn't help at all.

How is it not working???

It is working for me.

YOU attach your file, so that I can install.

[inoka]

Thanks for your reply.

When user enter above mentioned invalid date format, it is required to shown an error message.

But, this is not fulfilled that feature. However I have attached my excel file in below.

[inoka]

Hi,

Could you please help me to improve following attached excel sheet for my validation. It has included debug error examples. I need to allow only for the "DD/MM/YYYY" date format.
Highly appreciate your response and Thank you.

[jindon]

So, you didn't know how to adjust...

Change any cell(s) in Col.A, B

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    If Not Target.Column Like "[23]" Then Exit Sub
    If Target.Row < 3 Then Exit Sub
    Application.EnableEvents = False
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(0[1-9]|[12][0-9]|3[01])/(0[1-9]|1[0-2])/\d{4}$"
        For Each r In Intersect(Target, Columns("b:c"))
            If Len(Target.Text) Then
                If (.test(r.Text) * IsDate(r.Text)) = 0 Then
                    MsgBox "Invalid date", , r.Text & " " & r.Address(0, 0)
                    r.ClearContents
                End If
            End If
        Next
    End With
    Application.EnableEvents = True
End Sub

[inoka]

Thank you so much. It;s working. . could you please explain me, from where it is maintained column name.
ex: If i need to validate it for columns "D","E",and "G", where do I need to change?

[jindon]

Try change to

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, r As Range
    Set rng = Intersect(Target, Range("d:e,g:g"), Rows("3:" & Rows.Count))
    If rng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(0[1-9]|[12][0-9]|3[01])/(0[1-9]|1[0-2])/\d{4}$"
        For Each r In rng
            If Len(Target.Text) Then
                If (.test(r.Text) * IsDate(r.Text)) = 0 Then
                    MsgBox "Invalid date", , r.Text & " " & r.Address(0, 0)
                    r.ClearContents
                End If
            End If
        Next
    End With
    Application.EnableEvents = True
End Sub

[inoka]

Thank you so much for your reply. I can not understand what is the method to apply it for desired column. I need to apply it for following columns.

M, T, U, Z, AB, AC, AD, AH, AI, CS, CT

Also, I need to validate it only 2 numbers for Date and 2 numbers for Month. and 4 numbers for Year. (DD/MM/YYYY)

If you can upload excel sheet with these validation, it will be great help for me.

[jindon]

Also, I need to validate it only 2 numbers for Date and 2 numbers for Month. and 4 numbers for Year. (DD/MM/YYYY)

What's wrong with the current code?
You are really confusing us, it only allows dd/mm/yyyy entry as you requested.

If you are not able to adjust the code, you should ask everything in the first place.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, r As Range
    Set rng = Intersect(Target, Range("M:M,T:U,Z:Z,AB:AD,AH:AI,CS:ST"), Rows("3:" & Rows.Count))
    If rng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(0[1-9]|[12][0-9]|3[01])/(0[1-9]|1[0-2])/\d{4}$"
        For Each r In rng
            If Len(Target.Text) Then
                If (.test(r.Text) * IsDate(r.Text)) = 0 Then
                    MsgBox "Invalid date", , r.Text & " " & r.Address(0, 0)
                    r.ClearContents
                End If
            End If
        Next
    End With
    Application.EnableEvents = True
End Sub

[inoka]

Thank you so much. Great... it's working.
Sorry for inconvenience.

[jindon]

If that takes care of your original question, select Thread Tools from the menu link above and mark this thread as SOLVED.

[inoka]

There's a some issue. When I enter data value with "0", automatically, it is discarded initial "0" value. Then, it is shown as one digit number and it is displayed as error.

Ex: when I add date as 04/06/2018, automatically excel converts it into 4/6/2018 and it is shown as invalid data.
When I add date as 23/04/2019, automatically excel converts it into 23/4/2019 and it is shown as invalid data.

Everything is working properly, how do I avoid this automatic conversion.

[jindon]

..............................

If that takes care of your original question, select Thread Tools from the menu link above and mark this thread as SOLVED.

[jindon]

That means the cell is formatted as d/m/yyyy.

Reset the cell format as STRING.

[inoka]

Thank you so much. It's working properly...