Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case 8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

Hi Norman
this works for me if the cells are formated as 'General' or another
number format. If the cells are preformated as date I got an error in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for example is
to large for a date value. so the procedure errors out and you get the
'invalid date' message.
Format the cell as General and try again and everything works fine.
Not sure right now how to prevent this error just as a shor summary of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case 8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or another
number format. If the cells are preformated as date I got an error in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works fine.
Not sure right now how to prevent this error just as a shor summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case 8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

Hi Frank!

Thanks! That change of Value to Formula did it.

We can now offer a European version.

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or another
number format. If the cells are preformated as date I got an error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works fine.
Not sure right now how to prevent this error just as a shor summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

Hi Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or another
number format. If the cells are preformated as date I got an error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works fine.
Not sure right now how to prevent this error just as a shor summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

Hi Norman
maybe Chip will add this to his site

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi Frank!

Thanks! That change of Value to Formula did it.

We can now offer a European version.

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or
another
number format. If the cells are preformated as date I got an error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works
fine.
Not sure right now how to prevent this error just as a shor
summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

Hi Norman,

It seems to work fine for me. I have tried 11121998 and 31122004, no
problems. What is happening when you run it?

It does seem to fail if you enter a date, and then try and re-enter/change
it (<Overflow in Target.Value), but Chip's version seems to do the same. I
take it this is not the problem you are getting.

--

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!

I'm amending Chip Pearson's quick date entry subroutine for the non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case 8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

Hi Norman
the leading zero is skipped. So this is intrepreted as 90298 (case 5).
enter the value with a leading apostrophe and it works (though this is
not a desired result).

Will take a look into this (same problem will occur in all other cases
with a leading zero)

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or
another
number format. If the cells are preformated as date I got an error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works
fine.
Not sure right now how to prevent this error just as a shor
summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

"Bob Phillips" schrieb im
Newsbeitrag ...
Hi Norman,

It seems to work fine for me. I have tried 11121998 and 31122004, no
problems. What is happening when you run it?

It does seem to fail if you enter a date, and then try and
re-enter/change
it (<Overflow in Target.Value), but Chip's version seems to do the
same. I
take it this is not the problem you are getting.

Hi Bob
this was the problem. Maybe Chip should change his macro also to
target.formula :-)

Frank

Hi Bob!

Using a naked workbook, I've inserted the code and then tried testing.

Format is General in the Target range. Frank's suggestion has cleared
the difficult Case 8 which I've been bashing my head on but now Case 6
stuffs up.

I've also hit the same problem of you with re-enter / changing but as
you say that's inherent in the method.

I'm coming round to the view that it might be better to start from
scratch and use a dd-mmm-yyyy entry.

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Bob Phillips" wrote in message
...
Hi Norman,

It seems to work fine for me. I have tried 11121998 and 31122004, no
problems. What is happening when you run it?

It does seem to fail if you enter a date, and then try and
re-enter/change
it (<Overflow in Target.Value), but Chip's version seems to do the
same. I
take it this is not the problem you are getting.

--

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!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case 8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

"Norman Harker" schrieb im Newsbeitrag
...
[...]
I've also hit the same problem of you with re-enter / changing but as
you say that's inherent in the method.

This should be solved by the change to target.formula


I'm coming round to the view that it might be better to start from
scratch and use a dd-mmm-yyyy entry.

:-)

Norman,

Try this, it traps the selection event to set the cell format before input,
and also uses formulalocal

Option Explicit

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Exit Sub
End If

If Target.Cells.Count 1 Then
Exit Sub
End If

Target.NumberFormat = "@"

End Sub


--

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 Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or another
number format. If the cells are preformated as date I got an error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works fine.
Not sure right now how to prevent this error just as a shor summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

An alternative is to test Target.Formula as Frank says, and just set the
numberformat if all ism okay to process. The problem with 6 digits was there
before Frank suggested Target.Formula, and is addressed by changing the
numberformat. I have added FormulaLocal as inpuuting 020998 reveresed the
date to 9/2/1998.

This version also gets over the initial input where nothing gets selected.

Option Explicit

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.Formula= "" Then
Exit Sub
End If

Target.NumberFormat = "@"

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 4 ' e.g., 9298 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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

Dates are a pain, and the MS implementation has a high aroma.

--

HTH

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

"Bob Phillips" wrote in message
...
Norman,

Try this, it traps the selection event to set the cell format before
input,
and also uses formulalocal

Option Explicit

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Exit Sub
End If

If Target.Cells.Count 1 Then
Exit Sub
End If

Target.NumberFormat = "@"

End Sub


--

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 Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or another
number format. If the cells are preformated as date I got an error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you get
the
'invalid date' message.
Format the cell as General and try again and everything works fine.
Not sure right now how to prevent this error just as a shor summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

Hi Bob
still problems with that function:
- also omits leading zeros (don't think there's something you can do
about this if the cell is not preformated as 'Text')
- result is stored as 'Text'. At least a different numberformat at the
end should be added

So I think the best one can achieve is the change of the
target.value="" to target.formula=""
I think also chips original code has the same problem with leading
zeros.

--
Regards
Frank Kabel
Frankfurt, Germany

"Bob Phillips" schrieb im
Newsbeitrag ...
An alternative is to test Target.Formula as Frank says, and just set
the
numberformat if all ism okay to process. The problem with 6 digits
was there
before Frank suggested Target.Formula, and is addressed by changing
the
numberformat. I have added FormulaLocal as inpuuting 020998 reveresed
the
date to 9/2/1998.

This version also gets over the initial input where nothing gets
selected.

Option Explicit

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.Formula= "" Then
Exit Sub
End If

Target.NumberFormat = "@"

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 4 ' e.g., 9298 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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

Dates are a pain, and the MS implementation has a high aroma.

--

HTH

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

"Bob Phillips" wrote in message
...
Norman,

Try this, it traps the selection event to set the cell format
before
input,
and also uses formulalocal

Option Explicit

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("A1:A10")) Is Nothing
Then
Exit Sub
End If

If Target.Cells.Count 1 Then
Exit Sub
End If

Target.NumberFormat = "@"

End Sub


--

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 Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or
another
number format. If the cells are preformated as date I got an
error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you
get
the
'invalid date' message.
Format the cell as General and try again and everything works
fine.
Not sure right now how to prevent this error just as a shor
summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im
Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for
the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept
Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula,
2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula,
2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula,
4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

Frank,

You are right. I must have got my code mixed up in changing.

My previous version, with the selection event is better, it just suffers the
restriction that it requires a cell to be selected, which doesn't always
happen.

--

HTH

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

"Frank Kabel" wrote in message
...
Hi Bob
still problems with that function:
- also omits leading zeros (don't think there's something you can do
about this if the cell is not preformated as 'Text')
- result is stored as 'Text'. At least a different numberformat at the
end should be added

So I think the best one can achieve is the change of the
target.value="" to target.formula=""
I think also chips original code has the same problem with leading
zeros.

--
Regards
Frank Kabel
Frankfurt, Germany

"Bob Phillips" schrieb im
Newsbeitrag ...
An alternative is to test Target.Formula as Frank says, and just set
the
numberformat if all ism okay to process. The problem with 6 digits
was there
before Frank suggested Target.Formula, and is addressed by changing
the
numberformat. I have added FormulaLocal as inpuuting 020998 reveresed
the
date to 9/2/1998.

This version also gets over the initial input where nothing gets
selected.

Option Explicit

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.Formula= "" Then
Exit Sub
End If

Target.NumberFormat = "@"

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 4 ' e.g., 9298 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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

Dates are a pain, and the MS implementation has a high aroma.

--

HTH

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

"Bob Phillips" wrote in message
...
Norman,

Try this, it traps the selection event to set the cell format
before
input,
and also uses formulalocal

Option Explicit

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula, 4)
Case 8 ' e.g., 11121998 = 11-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
Case Else
Err.Raise 0
End Select
.FormulaLocal = 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


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("A1:A10")) Is Nothing
Then
Exit Sub
End If

If Target.Cells.Count 1 Then
Exit Sub
End If

Target.NumberFormat = "@"

End Sub


--

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 Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi
try changing the lines

If Target.Value= "" Then
Exit Sub
End If

to
If Target.Formula = "" Then
Exit Sub
End If

--
Regards
Frank Kabel
Frankfurt, Germany

"Frank Kabel" schrieb im Newsbeitrag
...
Hi Norman
this works for me if the cells are formated as 'General' or
another
number format. If the cells are preformated as date I got an
error
in
the line
If Target.Value = "" Then

Seems that i this case you get an overflow as '11111998' for
example
is
to large for a date value. so the procedure errors out and you
get
the
'invalid date' message.
Format the cell as General and try again and everything works
fine.
Not sure right now how to prevent this error just as a shor
summary
of
my findings

--
Regards
Frank Kabel
Frankfurt, Germany

"Norman Harker" schrieb im
Newsbeitrag
...
Hi All!

I'm amending Chip Pearson's quick date entry subroutine for
the
non-US
date entry.

What's wrong with Case 8?

I've amended 4,5,6 and 7 but can't seem to get it to accept
Case
8.

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 = 9-Feb-1998
DateStr = Left(.Formula, 1) & "/" & _
Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
Case 5 ' e.g., 11298 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula,
2)
Case 6 ' e.g., 090298 = 9-Feb-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 2) & "/" & Right(.Formula,
2)
Case 7 ' e.g., 1121998 = 11-Feb-1998 NOT 1-Dec-1998
DateStr = Left(.Formula, 2) & "/" & _
Mid(.Formula, 3, 1) & "/" & Right(.Formula,
4)
Case 8 ' e.g., 11121998 = 11-Dec-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

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and
Arguments)
available free to good homes.

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.

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:

Hi Bob, Norman

I have some problems with this version <vbg
1. You're not able to enter any formulas in this range anymore as the
Selection_Change event formats the cell to 'Text' and a formula is no
longer recognized

2. You can't calculate with the resulting value as it's stored as
'Text.

One could help the second one if you use
With Target
'In goes the parsed date
.NumberFormat = DateFormat
.Value = DateValue(DateStr)
End With

but this will lead to a conversion of the entered dates to their serial
number if you select them again. To prevent this Norman inserted his
'otiose code' but this will lead to problems for re-entries and leading
zeros...

So I would prefer Norman's first solution (with Bob's additions in
respect to contant values) and live with the 'leading zeros' problem.


--
Regards
Frank Kabel
Frankfurt, Germany

"Bob Phillips" schrieb im
Newsbeitrag ...
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).

Hi Bob!

Thanks for that! But now the date is in text form and I'm not getting
dd-mmm-yyyy. Otherwise it is testing OK

VB = Victoria Bitter

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

Hi Frank!

I think the otiose code goes back. I can live with the re-entry
problem unless there's another way.

I'm not getting leading 0 problems in the original because I had text
to parse. Only 0 problem was impossible 0 days and months.

That conversion of dates back to serial numbers on re-selection was
also a real problem.

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
"Frank Kabel" wrote in message
...
Hi Bob, Norman

I have some problems with this version <vbg
1. You're not able to enter any formulas in this range anymore as
the
Selection_Change event formats the cell to 'Text' and a formula is
no
longer recognized

2. You can't calculate with the resulting value as it's stored as
'Text.

One could help the second one if you use
With Target
'In goes the parsed date
.NumberFormat = DateFormat
.Value = DateValue(DateStr)
End With

but this will lead to a conversion of the entered dates to their
serial
number if you select them again. To prevent this Norman inserted his
'otiose code' but this will lead to problems for re-entries and
leading
zeros...

So I would prefer Norman's first solution (with Bob's additions in
respect to contant values) and live with the 'leading zeros'
problem.


--
Regards
Frank Kabel
Frankfurt, Germany

"Bob Phillips" schrieb im
Newsbeitrag ...
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).

Hi Norman
so though this is not a 100% solution it is nearly o.k
Would you email/send this to chip to include this on his site (for
further references) ?


--
Regards
Frank Kabel
Frankfurt, Germany


Norman Harker wrote:
Hi Frank!

I think the otiose code goes back. I can live with the re-entry
problem unless there's another way.

I'm not getting leading 0 problems in the original because I had text
to parse. Only 0 problem was impossible 0 days and months.

That conversion of dates back to serial numbers on re-selection was
also a real problem.

Hi Frank!

My final version is below.

I had trouble with the DateFormat constant. Also the TestRange
constant appears "sticky" so there might be change to that one.

I put back the format if the cell is already a date

I found a more acceptable response to amending a date which is to
amend the EndMacro error treatment: clear the bugger and format as
text. OK I still get the error message when I really shouldn't but it
doesn't then leave me with the date represented by the date serial
number of the entry.

Still a bit of testing to do, but I think it works OK. I'll post to
Chip. On his site, in the lead in he says, "If you use European style
dates (ddmmyyyy), you'll have to change some of the code." I'm going
to report him to the NSPCA!

I suppose that to be a bit more bullet proof it needs code that checks
the date settings and then runs the US or European code accordingly.
But I think I'll put that in the very large "to do" file.



Const TestRange As String = "A1:A10"

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

'If I already have a date then just format
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(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 = Format(DateValue(DateStr), "dd-mmm-yyyy")
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
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

Hi Norman

like your solution but I wasn't satisfied with the small drawbacks
(re-entry of 6 digits or leading zeros). So I Changed the
selection_Change event as posted below:
- included a static variable for the previous selection
- ALWAYS change the format of the selected cell to 'Text'
- BUT restore the date format again after the selection has left the
filled cell.

One drawback: The user sees the conversion to a serial date number if
he selects a filled date cell. No idea how to prevent this.
Waiting for your' (and Bob's) comments <vbg

------
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
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

'Frank Kabel: Disabled as no longer needed
'If I already have a date then just format
'If IsDate(Target.Value) Then
' Target.NumberFormat = "dd-mmm-yyyy"
' Exit Sub
'End If

'Format as text to prevent dropping leading 0
Target.NumberFormat = "@"

'set the static variable
Set OldSelection = Target
End Sub



--
Regards
Frank Kabel
Frankfurt, Germany


Norman Harker wrote:
Hi Frank!

My final version is below.

I had trouble with the DateFormat constant. Also the TestRange
constant appears "sticky" so there might be change to that one.

I put back the format if the cell is already a date

I found a more acceptable response to amending a date which is to
amend the EndMacro error treatment: clear the bugger and format as
text. OK I still get the error message when I really shouldn't but it
doesn't then leave me with the date represented by the date serial
number of the entry.

Still a bit of testing to do, but I think it works OK. I'll post to
Chip. On his site, in the lead in he says, "If you use European style
dates (ddmmyyyy), you'll have to change some of the code." I'm going
to report him to the NSPCA!

I suppose that to be a bit more bullet proof it needs code that
checks
the date settings and then runs the US or European code accordingly.
But I think I'll put that in the very large "to do" file.

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.

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

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



--
Regards
Frank Kabel
Frankfurt, Germany


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.

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.

Hi Frank!

If you're used to editing in cell, it can be distracting but I suppose
on balance I prefer it and you'd soon get used to it.

For "true" European format I suppose yyyy-mm-dd should be used but
then you wouldn't expect an ex-Pom to be a true European <vbg

I tend to use a non-white base colour as it's more restful on
bloodshot eyes.

I think Bob wants to stay married and has gone to bed!
--
Regards
Norman Harker MVP (Excel)
Sydney, Australia

Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.