Posted to microsoft.public.excel.programming
|
|
Quick Date Entry European
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.
|