Formatting a date from an input box

[posheroff]

I am using an input box to enter a date. I'd like the end user to only have
to enter a 2-digit year, but have the system convert it to a 4 digit year.
How would I do that?

 

[Rick Rothstein]

Not sure where you are putting the output at, but you can use something like
this to do what you want...

Answer = InputBox("Enter a date")
If IsDate(Answer) Then Answer = Format(Answer, "m/d/yyyy")

to convert the user's input, if a valid date, to a 4-digit year. You can
then assign Answer to wherever you want.

 

[Chip Pearson]

Is the user entering only a year and no other data information? Or is
the user entering a date with separators (e.g., mm/dd/yy) or a date
without separators (e.g., mmddyy)?

The following code will allow the user to enter a date in any of the
following formats and will convert it to a real date:

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
MsgBox "Date Entered: " & DT
Else
MsgBox "Invalid Date: " & T
End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''

 

[Rick Rothstein]

I believe the shorter macro will do what your code does (plus it allows for
all entries without a year to end in a slash, not just your "mm/dd/" one)...

Sub ConvertDate()
Dim D As Date
Dim S As String
Dim Sin As String
Dim Sep As String
Sep = Application.International(xlDateSeparator)
Sin = Application.InputBox("Enter a date")
S = Trim(Sin)
Do While Right(S, 1) = Sep
S = Left(S, Len(S) - 1)
Loop
On Error GoTo Whoops
If Len(S) = 2 Then
D = DateSerial(S, 1, 1)
ElseIf InStr(S, Sep) Then
D = CDate(S)
Else
S = Format(S, "!&&" & Sep & "&&" & "/" & "&&&&")
If Right(S, 1) = Sep Then S = Left(S, Len(S) - 1)
D = CDate(S)
End If
MsgBox "Date entered: " & D
Exit Sub
Whoops:
MsgBox "Invalid date: " & Sin
End Sub

 

[Rick Rothstein]

In thinking about it, I *over protected* the code against slashes.
Correcting this reduces the code by two more lines...

Sub ConvertDate()
Dim D As Date
Dim S As String
Dim Sin As String
Dim Sep As String
Sep = Application.International(xlDateSeparator)
Sin = Application.InputBox("Enter a date")
S = Trim(Sin)
If Right(S, 1) = Sep Then S = Left(S, Len(S) - 1)
On Error GoTo Whoops
If Len(S) = 2 Then
D = DateSerial(S, 1, 1)
ElseIf InStr(S, Sep) Then
D = CDate(S)
Else
S = Format(S, "!&&" & Sep & "&&" & "/" & "&&&&")
If Right(S, 1) = Sep Then S = Left(S, Len(S) - 1)
D = CDate(S)
End If
MsgBox "Date entered: " & D
Exit Sub
Whoops:
MsgBox "Invalid date: " & Sin
End Sub