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" <(E-Mail Removed)> wrote in message
news:360186D8-A334-4492-A608-(E-Mail Removed)...
>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
Similar Threads
