G
Gustavo Strabeli
I have the function below that sets dates up automatically, I mean, if I
type "2711" on column L, this number will be changed to 27/11/07.
This funcion works well with dates up to 31/12/07. I was trying to file a
date 31/01/08 and it does not work. For your reference I'm typing "310108".
What do I need to change to have that working properly?
Function is:
Option Explicit
Dim varDate As Variant
Dim sDate As String
Dim isect As Range
Private Sub Worksheet_Change(ByVal Target As Range)
'If cell changed is not in date sheet range then exit
Set isect = Application.Intersect(Range("L:L"), Target)
If isect Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
sDate = Format(Target.Value, "0000")
varDate = Left(sDate, 2) & "," & Mid(sDate, 3, 2)
On Error GoTo DateError
Target.Value = DateValue(varDate)
Application.EnableEvents = True
Exit Sub
DateError:
'If invalid date or cell not formated for dates then error occurs
MsgBox "Date Input Error"
Target.Value = ""
Application.EnableEvents = True
End Sub
Thanks a lot,
Gustavo Strabeli.
type "2711" on column L, this number will be changed to 27/11/07.
This funcion works well with dates up to 31/12/07. I was trying to file a
date 31/01/08 and it does not work. For your reference I'm typing "310108".
What do I need to change to have that working properly?
Function is:
Option Explicit
Dim varDate As Variant
Dim sDate As String
Dim isect As Range
Private Sub Worksheet_Change(ByVal Target As Range)
'If cell changed is not in date sheet range then exit
Set isect = Application.Intersect(Range("L:L"), Target)
If isect Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
sDate = Format(Target.Value, "0000")
varDate = Left(sDate, 2) & "," & Mid(sDate, 3, 2)
On Error GoTo DateError
Target.Value = DateValue(varDate)
Application.EnableEvents = True
Exit Sub
DateError:
'If invalid date or cell not formated for dates then error occurs
MsgBox "Date Input Error"
Target.Value = ""
Application.EnableEvents = True
End Sub
Thanks a lot,
Gustavo Strabeli.