View Single Post
  #17   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default Quick Date Entry European

Norman,

You have re-introduced the problem whereby the initial input works okay, but
re-input into a cell without moving away and back again and it goes bang.

Here is a modification, removing the otiose code (that gave me problems),
changing the final assignment of the value, and with a couple of constants
to allow more friendly definition of the test range and date format (i.e.
easier to change).

Who is VB?

Const TestRange As String = "A1:H10"
Const DateFormat As String = "dd-mm-yyyy"

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(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 = "@"

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


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

End If
Application.EnableEvents = True
Exit Sub

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

End Sub 'Worksheet_Change



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Norman Harker" wrote in message
...
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: