Quick Date Entry European

N

Norman Harker

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
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 
F

Frank Kabel

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
 
F

Frank Kabel

Hi
try changing the lines

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

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

Norman Harker

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
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 
N

Norman Harker

Hi Frank!

I spoke too soon!

Case 6 now stuffs up

090298

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 
B

Bob Phillips

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

Frank Kabel

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

Frank Kabel

Bob Phillips said:
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.
Click to expand...

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

Frank
 
N

Norman Harker

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
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 
F

Frank Kabel

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

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.
Click to expand...

:)
 
B

Bob Phillips

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

Bob Phillips

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

Frank Kabel

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

Bob Phillips

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

Norman Harker

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
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 
B

Bob Phillips

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

Frank Kabel

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

Norman Harker

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
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 
N

Norman Harker

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
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Input format 3
Macro problems in XP 1
New Macros Not Being Listed In Macro Dialog Box? 2
Quick Date entry revisited 7
please help.is it possible re-edit macro to convert text like1530-2200 to time format automatically? 1
Combine two Codes into one Sheet 2
Excel 2007 ambiguous name detected:Worksheet_Change 3
Worksheet change time format 6

Top