|
This page describes the VBA procedures that will allow you to enter dates and times,
without having to enter in the "/" or ":" separators. For
example, you could enter 9298 and get the valid date 2-Sep-1998. Or you could enter
1234 and get the valid time 12:34:00 PM.
These methods use the Worksheet_Change event procedure to catch changes made to the
worksheet. For more information about using event procedures, click here.
The first procedure will test the location and value of the changed cell. If it
is in the range A1:A10, the value is converted to a proper
date. The value in the cell must be between 4 and 8 numbers in length. Otherwise an
error will occur.
NOTE: The procedure below is for USA-style dates (mmddyyyy
format). If you use European style dates (ddmmyyyy), you'll have to change
some of the code. That is left as an exercise for the reader.
NOTE: Be sure that you do not have the "Fixed Decimal" edit
setting turned on. This will cause unexpected results.
The rules for conversion are described below:
| Digits |
Example |
Remarks |
| 4 |
9298 |
Converted to 2-Sep-1998 |
| 5 |
11298 |
Converted to 12-Jan-1998, NOT 2-Nov-1998 |
| 6 |
112298 |
Converted to 22-Nov-1998 |
| 7 |
1231998 |
Converted to 23-Jan-1998, NOT 3-Dec-1998 |
| 8 |
11221998 |
Converted to 22-Nov-1998 |
Private Sub Worksheet_Change(ByVal Target As
Excel.Range)
Dim DateStr As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If
Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 4 ' e.g., 9298 = 2-Sep-1998
DateStr =
Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1)
& "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 12-Jan-1998 NOT
2-Nov-1998
DateStr =
Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 2-Sep-1998
DateStr =
Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1231998 = 23-Jan-1998 NOT
3-Dec-1998
DateStr =
Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 2) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 09021998 = 2-Sep-1998
DateStr =
Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.Formula = DateValue(DateStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid date."
Application.EnableEvents = True
End Sub
The next procedure will test the location and value of the changed cell. If it is
in the range A1:A10, the value is converted to a proper
time. The value in the cell must be between 1 and 6 numbers in length. Otherwise an
error will occur. The rules for conversion are described below:
| Digits |
Example |
Remarks |
| 1 |
1 |
Converted to 12:01:00 AM |
| 2 |
23 |
Converted to 12:23:00 AM |
| 3 |
123 |
Converted to 1:23:00 AM |
| 4 |
1234 |
Converted to 12:34:00 |
| 5 |
12345 |
Converted to 1:23:45, NOT 12:03:45 |
| 6 |
123456 |
Converted to 12:34:56 |
.
Private Sub Worksheet_Change(ByVal Target As
Excel.Range)
Dim TimeStr As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If
Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub
.
|
|