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

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

A question regarding this just came up recently in the newsgroups. Here is
the response I gave which offers a shorter piece of code (however, due to my
lack of international versions of Excel, I wasn't sure which function should
be use... although I would note the second one should always work). Anyway,
here is what I posted...

Assuming the locale always uses m, d and y for the month, day and year date
parts of the date format pattern string, you can use this function to return
the text string you want to display in the TextBox...

Function DateFormat() As String
DateFormat = CStr(DateSerial(2003, 1, 2))
DateFormat = Replace(DateFormat, "2003", "yyyy")
DateFormat = Replace(DateFormat, "03", "yy")
DateFormat = Replace(DateFormat, "01", "mm")
DateFormat = Replace(DateFormat, "1", "m")
DateFormat = Replace(DateFormat, "02", "dd")
DateFormat = Replace(DateFormat, "2", "d")
DateFormat = Replace(DateFormat, MonthName(1), "mmmm")
DateFormat = Replace(DateFormat, MonthName(1, True), "mmm")
End Function

To use this function, you would use a statement like this...

TextBox1.Text = DateFormat

Just to note, it also handles date formats in which the month name is
abbreviated or spelled out in full. If your locale can use different letters
for the month, day and year date parts, then this modification to the above
should work...

Function DateFormat(TheDate As Date) As String
DateFormat = CStr(DateSerial(2003, 1, 2))
With Application
DateFormat = Replace(DateFormat, "2003", String(4,
..International(xlYearCode)))
DateFormat = Replace(DateFormat, "03", String(2,
..International(xlYearCode)))
DateFormat = Replace(DateFormat, "01", String(2,
..International(xlMonthCode)))
DateFormat = Replace(DateFormat, "1", .International(xlMonthCode))
DateFormat = Replace(DateFormat, "02", String(2,
..International(xlDayCode)))
DateFormat = Replace(DateFormat, "2", .International(xlDayCode))
DateFormat = Replace(DateFormat, MonthName(1), String(4,
..International(xlMonthCode)))
DateFormat = Replace(DateFormat, MonthName(1, True), String(3,
..International(xlMonthCode)))
End With
End Function

--
Rick (MVP - Excel)


"ryguy7272" wrote in message
...
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