View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Frank Kabel Frank Kabel is offline
external usenet poster
 
Posts: 3,885
Default Quick Date Entry European

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.