Check Date Format Input into Excel Column with VBA code

[stanlelma]

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 yyyymmdd and could either be entered or pasted as a block of cells. i.e. It would be necessary to cycle thorugh the data.
A message box should appear if any invalid data is found and the option to clear the individualy cell with the bad entry or cancel the entire input provided.

Is this possible? Can anybody provide the VBA code for me to test?

[Leith Ross]

Hello stanlelma,

Rather than using VBA, have you considered Data Validation?

[stanlelma]

Thanks but Excel Data Validation does not prevent pasting of invalid data and this will be the most common input method.

[Leith Ross]

Hello stanlelma,

Do you have a workbook you can post?

[stanlelma]

Here is an example

[Leith Ross]

Hello stanlelma,

I added 2 macros to the attached workbook. These will validate that a number entered or copied into columns "D" or "F" of the sheet are in YYYY MM DD format. If not, a message box ask the user if they want to clear the cell or not.
Let me know if any changes need to be made.

Worksheet Change Event Code

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Cell As Range
    Dim Rng As Range
    
        Set Rng = Intersect(Target, Range("D:D,F:F"))
        If Rng Is Nothing Then Exit Sub
        
        For Each Cell In Rng
            If ValidateDate(Cell) = False Then
                Ans = MsgBox(Cell.Text & " is Not in YYYYMMDD Format." & vbCrLf _
                            & "Do You want to Clear this Cell?", vbYesNoCancel)
                If Ans = vbYes Then
                    Application.EnableEvents = False
                        Cell = ""
                    Application.EnableEvents = True
                End If
                
                If Ans = vbCancel Then Exit Sub
            End If
        Next Cell
        
End Sub

Module 3 Date Format Validation Macro

Function ValidateDate(ByVal DateCode As Long)

    Dim D As Integer
    Dim LeapYear As Boolean
    Dim M As Integer
    Dim Result As Boolean
    Dim Y As Integer
    
        Y = CInt(Left(DateCode, 4))
        M = CInt(Mid(DateCode, 5, 2))
        D = CInt(Right(DateCode, 2))
        
            If Y < 1900 Then ValidateDate = False: Exit Function
            
            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
            
        ValidateDate = Result
        
End Function

[stanlelma]

Thanks, This is a really cleaver why to code it. Just one small change that I can't get working myself.
I need the validation to pevent non-numeric entries. For Example: "any text" or 26/06/2013.

IsNumeric does not appear to prevent the text entry, but maybe I coded it wrong.

[Leith Ross]

Hello stanlelma,

The macro will only return True if the argument passed into is a number, can be converted to a date, and matches your format. So, what is the problem?

[stanlelma]

If I try to copy text into the range I get a Run-time error '13'.

[Leith Ross]

Hello stanlelma,

Sorry about that oversight. It takes only a single line to fix the problem. Here is the revised and working code.
Module3 Macro Code

Function ValidateDate(ByVal DateCode As Variant)

    Dim D As Integer
    Dim LeapYear As Boolean
    Dim M As Integer
    Dim Result As Boolean
    Dim Y As Integer
            
        If Not IsNumeric(DateCode) Then Exit Function
        
        Y = CInt(Left(DateCode, 4))
        M = CInt(Mid(DateCode, 5, 2))
        D = CInt(Right(DateCode, 2))
        
            If Y < 1900 Then ValidateDate = False: Exit Function
            
            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
            
        ValidateDate = Result
        
End Function

[stanlelma]

Perfect! Thank you very much

[stanlelma]

Actually two last enhancement if you would be so kind.

1) If I delete data from the range I get a Run-time error '13'.
2) I would like to prevent update of "any" data into the range even if one cell is invalid. Therefore after the message about invalid date format(s) is displayed the "whole" range of input data should be cleared.

Thanks again

[Leith Ross]

Hello Stanlelma,

I made the changes you requested. Please see the attached workbook for the code.

[stanlelma]

Works perfectly now. Thanks again. You are a genius!

Are you able help me with my other post : Check entry in Excel column if data is in the same row of a different column with VBA ?
I can not believe that this can not be done except manually after pasting as suggested.

[Leith Ross]

Hello stanlelma,

You're welcome.

No problem, I take a look right now.

[inoka]

Hello Leith Ross,
Could you please help me to do previous same functionality for the date format "DD/MM/YYYY".

[inoka]

Hello Leith Ross,
Could you please help me to do the previous same functionality for the date format "DD/MM/YYYY".

[blorgqq]

Hello Leith Ross,
Could you please help me to do the previous same functionality for the date format "DD/MM/YYYY".

Hi there

7 years late on this one, but I needed to do the same thing. I've found a way to solve this, but it may not necessarily be completely bullet-proof.
I've taken most of the code, but you'll see I do some specific checks. If the format is dd/mm/yyyy I expect, at least, that the minimum length is 8, and that there can be found exactly 2 instances of the "/" character. If at least that is true, then we're able to do the remaining checks in the code as written by Leith Ross.

Function ValidateDate(ByVal DateCode As Variant)

    Dim D As Integer
    Dim LeapYear As Boolean
    Dim M As Integer
    Dim Result As Boolean
    Dim Y As Integer
    
    Dim c As Integer
        c = 1
    Dim countSlash As Integer
        countSlash = 0
    
        Do While c <> Len(DateCode)
            If InStr(c, DateCode, "/") = 0 Then
                c = Len(DateCode)
            Else
                c = InStr(c, DateCode, "/") + 1
                countSlash = countSlash + 1
            End If
        Loop
        
        If (Len(DateCode) < 8 Or countSlash <> 2) And Not IsEmpty(DateCode) Then
            Exit Function
        End If
        
        If IsEmpty(DateCode) Then
            Y = 1900
            M = 1
            D = 1
        Else
            Y = CInt(Right(DateCode, 4)) 'CInt(Left(DateCode, 4))
            M = CInt(Mid(DateCode, InStr(DateCode, "/") + 1, InStr(InStr(DateCode, "/") + 1, DateCode, "/") - InStr(DateCode, "/") - 1)) 'CInt(Mid(DateCode, 5, 2))
            D = CInt(Left(DateCode, InStr(DateCode, "/") - 1)) 'CInt(Right(DateCode, 2))
        End If
        
        If Y < 1900 Then
            ValidateDate = False: Exit Function
        End If
        
        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
                End If
            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 If
        End Select
            
Finished:
        ValidateDate = Result
        
End Function

[FDibbins]

inoka welcome to the forum

Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.

[inoka]

How to write new one? I was unable to find the place. Actually, this thread is related to my issue. only one difference is my date format should be in "DD/MM/YYYY".

[FDibbins]

I understand it is related, but please read my comments about why we dont permit "hijacking" of other member's threads.

To starts a new thread, click on the Forum button towards the top of the page, select the forum you want (VBA), click Post New Thread, add your question and then copy/paste the link from this thread

[inoka]

I added new thread. But, I didn't receive any reply.

https://www.excelforum.com/excel-pro...ml#post4800575

[FDibbins]

Yes, actually you did

[FDibbins]

Thanks for the input

For future reference, please use code tags when posting code (see my signature on how to). I have added them for you - this time

[blorgqq]

Thanks for the input

For future reference, please use code tags when posting code (see my signature on how to). I have added them for you - this time

Noted - thanks kindly.