Norman
and another addition: In my tests I encounter the problem that after
re-entring invalid dates the format stays as 'Text' even for valid
dates in this cell. So I changed the line

..Value = Format(DateValue(DateStr), "dd-mmm-yyyy")

to
..Value = DateValue(DateStr)

No need for the formating as you have set the number format prior to
this line

---- Full Code (with white font color)


Const TestRange As String = "A1:A10"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'use a static variable to store the old selection.
'Used to restore the date format after a the selected cell with a
'value has been changed to text format
Static OldSelection As Range

'Restore the date format for filled cells. Disable events to prevent
'triggering the worksheet_change event
If Not OldSelection Is Nothing Then
With OldSelection
If .Value < "" Then
Application.EnableEvents = False
.NumberFormat = "dd-mmm-yyyy"
.Value = .Value
.Font.ColorIndex = xlColorIndexAutomatic
Application.EnableEvents = True
End If
End With
End If

'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(TestRange)) 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

'Format as text to prevent dropping leading 0
Target.NumberFormat = "@"
If Target.Value < "" Then
Target.Font.ColorIndex = 2
End If

'set the static variable
Set OldSelection = Target
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(TestRange)) 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"

With Target
'In goes the parsed date
.Value = DateValue(DateStr)
End With

End If
Application.EnableEvents = True
Exit Sub

EndMacro:
MsgBox "You did not enter a valid date."
Target.Clear
Target.NumberFormat = "@"
Application.EnableEvents = True

End Sub 'Worksheet_Change


--
Regards
Frank Kabel
Frankfurt, Germany


Frank Kabel wrote:
Hi Norman
to prevent seeing the serial number in the cell one may apply a white
font color within the Selection_change event. E.g. use the following
additions to the code:

[....]
If Not OldSelection Is Nothing Then
With OldSelection
If .Value < "" Then
Application.EnableEvents = False
.NumberFormat = "dd-mmm-yyyy"
.Value = .Value
.Font.ColorIndex = xlColorIndexAutomatic
Application.EnableEvents = True
End If
End With
End If

[....]
Target.NumberFormat = "@"
If Target.Value < "" Then
Target.Font.ColorIndex = 2
End If

---
but this is more a little bit playing around after midnight :-)
Drawback: If you re-enter something you won't see your entry in the
cell until you left the cell




Norman Harker wrote:
Hi Frank!

I think we're getting there!

I much prefer the new approach to variations and I'm sure we can
live
with seeing the date serial number if we select an entered cell.

It seems to be OK on my testing data set.