View Single Post
  #3   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
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.