| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Quick Date Entry European
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. |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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. |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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. |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
"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 |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
"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. :-) |
|
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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: |
|
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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). |
|
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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). |
|
#18
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
|
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quick Date Entry European
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. |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| How do I convert US date with 12hr format to European date 24hr | Excel Discussion (Misc queries) | |||
| how can i change european date format to american | Excel Discussion (Misc queries) | |||
| European date formats | Excel Worksheet Functions | |||
| CONVERT 11/23/04 US DATE FORMAT TO EUROPEAN 23/11/04 FATE | Excel Discussion (Misc queries) | |||
| Enter european date | Excel Programming | |||
Hybrid Mode
