Restrict date entered

[tiredofit]

The max date in Excel is 31 Dec 9999, which corresponds to the value 2958465.

How can I restrict users from entering a date after this value, using just VBA (as opposed to the Data Validation found under Data in the ribbon)?

The code below shows an Overflow error (when the cell I am inputting the date is formatted to Date).

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Value > 2958465 Then

    End If

End Sub

This is the best I can do:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Target.NumberFormat = "General"
    
    If Target.Value > 2958465 Then
    
        Target.Value = vbNullString
        
        MsgBox "too large"
        
    Else
    
        Target.NumberFormat = "dd/mm/yyyy;@"
    
    End If
    
End Sub

Thanks

 

[RoryA]

I'd assume you'll want to restrict it to a specific area in reality, but basically something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim cell As Range
   For Each cell In Target.Cells
      If cell.Value2 > 2958465 Then
        With Application
           .EnableEvents = False
           .Undo
           .EnableEvents = True
        End With
      End If
   Next

End Sub

 

[tiredofit]

I'd assume you'll want to restrict it to a specific area in reality, but basically something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim cell As Range
   For Each cell In Target.Cells
      If cell.Value2 > 2958465 Then
        With Application
           .EnableEvents = False
           .Undo
           .EnableEvents = True
        End With
      End If
   Next

End Sub

Thanks.

The syntax that makes it work is Value2, as opposed to Value.

So I changed my original code to:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Value2 > 2958465 Then
        
        Application.EnableEvents = False
        
        Application.Undo
        
        Application.EnableEvents = True
        
    End If

End Sub

and it worked.

 

[RoryA]

But will error if you change more than one cell at a time...

 

[tiredofit]

But will error if you change more than one cell at a time...

I've restricted the user to only allow one cell at a time with:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Target(1, 1).Select
    
End Sub