Hi All!
Thanks to a few ideas from Bob and Frank and of course the original
from Chip Pearson, this is what I now have:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Object here is to format as text as soon as selection is made.
'I'll change to a date format when I've parsed the entry.
'This avoids leading zero and other inadmissible date probs.
'Usual exit if not in my range
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Exit Sub
End If
'More than 1 cell selected is a no no.
If Target.Cells.Count 1 Then
Exit Sub
End If
'If I already have a date then just format (probably otiose?)
If IsDate(Target.Value) Then
Target.NumberFormat = "dd-mmm-yyyy"
Exit Sub
End If
'Format as text to prevent dropping leading 0
Target.NumberFormat = "@"
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'This is the European date entry / format version
'Credits: CP,NH,BP,FK,
VB
Dim DateStr As String
On Error GoTo EndMacro
'Usual exit if not in my range
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Exit Sub
End If
'More than 1 cell selected is a no no.
If Target.Cells.Count 1 Then
Exit Sub
End If
'Should this be changed or omitted?
If Target.Formula = "" Then
Exit Sub
End If
'Can't have my buggering about triggering an event
Application.EnableEvents = False
'Parse the text entry
If Target.HasFormula = False Then
Select Case Len(Target)
Case 4 ' e.g., 9298 = 9-Feb-1998
'I could trap annoying second digit 0 problem
DateStr = Left(Target, 1) & "/" & _
Mid(Target, 2, 1) & "/" & Right(Target, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
'I could trap annoying first or third digit 0 problem
DateStr = Left(Target, 2) & "/" & _
Mid(Target, 3, 1) & "/" & Right(Target, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(Target, 2) & "/" & _
Mid(Target, 3, 2) & "/" & Right(Target, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(Target, 2) & "/" & _
Mid(Target, 3, 1) & "/" & Right(Target, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(Target, 2) & "/" & _
Mid(Target, 3, 2) & "/" & Right(Target, 4)
Case Else
Err.Raise 0
End Select
'Now format the cell for a date
Target.NumberFormat = "dd-mmm-yyyy"
'In goes the parsed date
Target.Formula = DateValue(DateStr)
End If
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid date."
Application.EnableEvents = True
End Sub 'Worksheet_Change
It seems to test OK with a couple of annoyances with case 4 and 5
impossible 0 problems that can be trapped.
But do your worst as I'm the first to admit my limitations on
programming.
--
Regards
Norman Harker MVP (Excel)
Sydney, Australia
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.