none
Excel VBA check if cell contains date RRS feed

  • Question

  • Hi All,

    I want to check range of cells and want to allow only dates in them entered in mm/dd/yyyy format. I tried applying excel data validation but it also excepts if i enter date as 1/1 (no year entered or 1 Jan)

    I also tried below code but it also do not throw error if date in entered without year like 1/1 or 1 Jan

    Private Sub Worksheet_Activate()
    If Not IsDate(ActiveSheet.Range("A1").Value) And ActiveSheet.Range("A1").NumberFormat <> "m/d/yyyy" Then
    MsgBox "Date is not valid"
    End If
    
    End Sub

    I want code to check 2 things.

    1. value in cell must be date and
    2. date must be in MM/DD/YYYY format
    3. even if that cell is blank than error msg box shall pop up.

    Thanks,

    Zaveri


    • Edited by zaveri cc Wednesday, April 1, 2015 1:38 PM
    Wednesday, April 1, 2015 1:37 PM

All replies

  • Date values are numbers, eg today's date as a date value is 42095 (days since 1/1/1900).

    Your event code can check the date value is within a valid range, and if OK correct the numberformat if/as necessary. Adapt the following to your needs

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sAdd As String
    Dim dtOldest As Date
    Dim dtLatest As Date
    Dim rng As Range, cel As Range
    Static bExit As Boolean
    
        If bExit Then
            Exit Sub
        Else
            bExit = True
        End If
    
        On Error GoTo errExit
        saddr = "A1:A10"  ' << change
        dtOldest = #1/1/2000#    'm/d/y
        dtLatest = #12/31/2019#
    
        Set rng = Intersect(Range(saddr), Target)
    
        If Not rng Is Nothing Then
            bExit = True
            For Each cel In rng
                If IsDate(cel) Then
                    If cel.Value < dtOldest Or cel.Value > dtLatest Then
                        MsgBox "Dates must be between " & _
                               Format(dtOldest, "mm\/dd\/yyyy") & " - " & _
                               Format(dtLatest, "mm\/dd\/yyyy")
                        cel.Clear
                    ElseIf cel.NumberFormat <> "mm/dd/yyyy" Then
                        cel.NumberFormat = "mm\/dd\/yyyy"
                    End If
                Else
                    MsgBox cel.Address & " " & cel.Text & vbCr & " is not a valid date"
                    cel.Clear
                End If
            Next
    
        End If
    
    errExit:
        bExit = False
    End Sub
    

    Paste the code in the relevant worksheet module

    Wednesday, April 1, 2015 2:16 PM
    Moderator
  • Hi Peter,

    Thanks for quick reply.

     I am cheking date in sheet 1 = A1 and i am entering aaaaa in cell A1 but code is not catching anything.

    Below is the code

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sAdd As String
    Dim dtOldest As Date
    Dim dtLatest As Date
    Dim rng As Range, cel As Range
    Static bExit As Boolean
    
        If bExit Then
            Exit Sub
        Else
            bExit = True
        End If
    
        On Error GoTo errExit
        saddr = ActiveSheet.Range("A1")  ' << change
        dtOldest = #1/1/1900#    'm/d/y
        dtLatest = #12/31/2200#
    
        Set rng = ActiveSheet.Intersect(Range(saddr), Target)
    
        If Not rng Is Nothing Then
            bExit = True
            For Each cel In rng
                If IsDate(cel) Then
                    If cel.Value < dtOldest Or cel.Value > dtLatest Then
                        MsgBox "Dates must be between " & _
                               Format(dtOldest, "mm\/dd\/yyyy") & " - " & _
                               Format(dtLatest, "mm\/dd\/yyyy")
                        cel.Clear
                    ElseIf cel.NumberFormat <> "mm/dd/yyyy" Then
                        cel.NumberFormat = "mm\/dd\/yyyy"
                    End If
                Else
                    MsgBox cel.Address & " " & cel.Text & vbCr & " is not a valid date"
                    cel.Clear
                End If
            Next
    
        End If
    
    errExit:
        bExit = False
    End Sub

    Thanks,

    Zaveri

    Wednesday, April 1, 2015 3:13 PM
  • You changed the code so that it will error, it will skip to the error handler and bail out. If you only want to check the cell in A1 change my original 

    sAddr = "A1:A10"

    to

    sAddr = "A1"

    The way you changed it will return contents of A1 to the string variable sAddr, rather than the address you want to check

    Actually I also see a small typo in the code I posted, change

    Dim sAdd As String
    to
    Dim sAddr As String

    Wednesday, April 1, 2015 3:46 PM
    Moderator
  • Hi Peter,

    can you please check your code in excel because i made proper changes in my code and entered text in A1 but it doesn't show any msgbox

    Thanks,

    Zaveri

    Wednesday, April 1, 2015 5:11 PM
  • The code I originally posted works, the code you posted works after I made the correction I mentioned.

    Try pasting my original code into the sheet module, do not change it. The enter a variety of valid and non valid dates in A1:A10


    Wednesday, April 1, 2015 5:36 PM
    Moderator
  • Hi zaveri,

    Base on my test with Peter’s code, it works fine. You could set the breakpoint and debug the code to check it.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, April 2, 2015 7:18 AM
    Moderator