Private Sub Worksheet_Change for entering dates without "/" unexpectedly stops running after 3 dates are entered

Question

I'm trying to make a simple code that can make data entry a little bit faster. A user should be able to type 13 for Jan 3rd, 22 for Feb 2nd, 310 for Mar 10th, 1005 for Oct 5th, 1220 for Dec 20th. All of the dates would use today's year.

The code seems to break, but still function, just incorrectly after performing as expected for 3 cells. Then, if I delete the column or reload the workbook it works again as intended, but only for the first 3 cells.

By still function, just incorrectly, it treats 13 as Jan 13, 1990; 22 as Jan 22, 1990; 310 as the 310th day of 1990; 1005 as the 1,220th day after Dec 31, 1899; and etc.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C:C"), Target) Is Nothing Then
        If Selection.Count > 1 Then
            Exit Sub
        End If

        TLen = Len(Target)
        DaV = Target

        If TLen = 2 Then
            DaV = DateSerial(Year(Now), Left(Target, 1), Right(Target, 1))
        ElseIf TLen = 3 Then
            DaV = DateSerial(Year(Now), Left(Target, 1), Right(Target, 2))
        ElseIf TLen = 4 Then
            DaV = DateSerial(Year(Now), Left(Target, 2), Right(Target, 2))
        Else
            Exit Sub
        End If

        Application.EnableEvents = False
        Target = DaV
        Target.NumberFormat = "yyyy-mm-dd"
        Application.EnableEvents = True
    End If
End Sub

Answer 1

Explanation

The main problem with your code is that you are using .Value instead of .Value2

You may want to read up on What is the difference between .text, .value, and .value2?

The problem is when you format a cell, Excel automatically copies the format to the next cell below it. And since you are using .Value, the code picks up the formatted value. So it is a good idea to store the value in a variable and use that.

So if you put a breakpoint in your code at TLen = Len(Target) you will get 10 instead of 4 for 1005. If you use .Value2 you will get 4 and not 10 or 5(For Date stored as number).

I have also added few more checks. For example when extracted month is greater then 12 or extracted day is greater than 31 and also for the leap year. I have also added a check for Strings else you will get an error for string which have 2-4 length.

I have commented the code so you should not have a problem understanding it. If you still do, then let me know.

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    '~~> Error Handling
    On Error GoTo Whoa
    
    '~~> Check if there is more than one cell was changed
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    Application.EnableEvents = False
    
    Dim D As Long, M As Long
    Dim TLen As Long
    Dim dt As String
    Dim FinalDate As Date
    
    '~~> Check if the change happened in column C
    If Not Intersect(Columns(3), Target) Is Nothing Then
        '~~> Get the value of changed cell
        dt = Target.Value2
        '~~> Get the length
        TLen = Len(dt)
        
        '~~> String check
        If Not IsNumeric(Target.Value2) Then GoTo Letscontinue
        
        '~~> FIRST CHECK: If the length is not as expected do nothing
        If TLen < 2 Or TLen > 4 Then GoTo GoToFormatAndExit
        
        '~~> Get the date and month
        Select Case TLen
            Case 2
                D = Right(dt, 1)
                M = Left(dt, 1)
            Case 3
                D = Right(dt, 2)
                M = Left(dt, 1)
            Case 4
                D = Right(dt, 2)
                M = Left(dt, 2)
        End Select
        
        '~~> FEW CHECKS: TO get correct dates
        '~~> Month more than 12
        If M > 12 Then GoTo GoToFormatAndExit
        '~~> Date more than 31
        If D > 31 Then GoTo GoToFormatAndExit
        '~~> Leap year
        If D > 28 And M = 2 And isLeapYear(Year(Now)) Then GoTo GoToFormatAndExit
        
        '~~> Construct final date
        FinalDate = DateSerial(Year(Now), M, D)
        
        '~~> Check if Excel created an incorrect date
        If Year(FinalDate) <> Year(Now) Then GoTo GoToFormatAndExit
        
        Target = FinalDate
        Target.NumberFormat = "yyyy-mm-dd"
    End If
    
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
    
GoToFormatAndExit:
    Application.EnableEvents = True
    '~~> Excel changes the format so keep it as general
    Target.NumberFormat = "General"
    Exit Sub
    
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Public Function isLeapYear(Yr As Integer) As Boolean
    isLeapYear = (Month(DateSerial(Yr, 2, 29)) = 2)
End Function

In Action

Disclaimer:

I may have missed few more checks as I have not thouroughly tested this. Feel free to improvise the code.