I found this code from an old Chip Pearson post:
'yy
'm/d (current year assumed)
'm/dd (current year assumed)
'mm/d (current year assumed)
'mm/dd (current year assumed)
'mm/dd/ (current year assumed)
'mm/dd/yy
'mm/dd/yyyy
'mmdd (current year assumed)
'mmddyy
'mmddyyyy
'all other formats are invalid.
'''''''''''''''''''''''''''''''''''''''''''''''''
Sub AAA()
Dim S As String
Dim T As String
Dim DT As Date
Dim Sep As String
Dim N As Long
Sep = Application.International(xlDateSeparator)
S = Application.InputBox("Enter a date")
If StrPtr(S) = 0 Then
' user cancelled
Exit Sub
End If
N = InStr(1, S, Sep, vbBinaryCompare) 0
If N 0 Then
Select Case Len(S)
Case 3
' m/d
T = S & Sep & Format(Year(Now), "0000")
Case 4
If N = 2 Then
' m/dd
T = "0" & Left(S, 1) & Sep & Right(S, 2) & _
Sep & Format(Year(Now), "0000")
ElseIf N = 3 Then
' mm/d
T = Left(S, 2) & Sep & "0" & Right(S, 1) & _
Sep & Format(Year(Now), "0000")
Else
' invalid
T = S
End If
Case 5
' mm/dd
T = S & Sep & Format(Year(Now), "0000")
Case 6
' mm/dd/
T = S & Format(Year(Now), "0000")
Case 8
' mm/dd/yy
T = Left(S, 6) & "20" & Right(S, 2)
Case 10
' mm/dd/yyyy
T = S
Case Else
End Select
Else
Select Case Len(S)
Case 2
' yy
T = "1" & Sep & "1" & Sep & "20" & S
Case 4
' mmdd
T = Left(S, 2) & Sep & Right(S, 2) & Sep & _
Format(Year(Now), "0000")
Case 6
' mmddyy
T = Left(S, 2) & Sep & Mid(S, 3, 2) & Sep & _
"20" & Right(S, 2)
Case 8
' mmddyyyy
T = Left(S, 2) & Sep & Mid(S, 3, 2) & _
Sep & Right(S, 4)
Case Else
T = S
End Select
End If
On Error Resume Next
Err.Clear
DT = DateValue(T)
If Err.Number = 0 Then
ActiveSheet.Range("A1") = DT
Else
MsgBox "Invalid Date: " & T
End If
End Sub
This concept may be MUCH easier to work with:
http://www.rondebruin.nl/calendar.htm
I love chip's code, but I would probably go with option #2 if i were you.
HTH,
Ryan---
--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.
"JacyErdelt" wrote:
I apologize if this is redundant, but I am having a small problem. The
purpose of the following code is to allow the user to enter a date into a
textbox without having to enter slashes or hyphens (040109 = 04/01/09). It
works for the most part, but instead of coming out as 04/01/09, it comes out
as 01/04/09. Every time it swtiches the day and month. Any suggestions as to
why it might be doing this, and what I can do to fix it. Here is what I have;
Private Sub txtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim nDay As Long, nMonth As Long, nYear As Long
Dim d As Date
If IsDate(txtDate.Value) = True Then
txtDate.Value = Format(txtDate.Value, "mm/dd/yy")
Else:
nDay = CLng(Left(txtDate.Text, 2))
nMonth = CLng(Mid(txtDate.Text, 3, 2))
nYear = CLng(Right(txtDate.Text, Len(txtDate.Text) -4 ))
d = DateSerial(nYear, nMonth, nDay)
txtDate.Value = d
txtDate.Value = Format(txtDate.Value, "mm/dd/yy")
End If
End Sub