User Form .SetFocus Help

[zoom38]

Hello all, I have a userform that asks for 5 date entries in textboxes and then places the values on a spreadsheet if entered correctly. My issue is that if a date is entered incorrectly as per my date validation function, the cursor automatically goes to the next text box. I'm trying to keep the cursor in the textbox if the data is entered incorrectly. I've tried .SetFocus but not sure why its not working or if i'm putting it in the right place. Below is some of the code i'm using but you can see it all on the attached spreadsheet.



Private Sub TextBox1_Enter()
With TextBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub

Private Sub UserForm_Initialize()
TextBox1.Text = "MM/DD/YYYY"
TextBox2.Text = "MM/DD/YYYY"
TextBox3.Text = "MM/DD/YYYY"
TextBox4.Text = "MM/DD/YYYY"
TextBox5.Text = "MM/DD/YYYY"
End Sub

Private Sub userform_activate()
VacationPeriodEntries.Caption = "Vacation Period Entry Form"
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
z = 1
If KeyCode = 13 Or KeyCode = 9 Then
CheckDates Me.TextBox1.Value
If Me.TextBox1.TextLength <> 10 Then
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Exit Sub
End If
Call CopyVacationPeriods
End If
End Sub


I am using Excel 2003 although the attachment was saved in Excel 2010.
Any help would be appreciated.

Thanks
Gary

[SamT]

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = CheckDate(Me.TextBox1)
End Sub


Private Function CheckDate(Ctrl As MSForms.TextBox) As Boolean
If Not IsDate(Ctrl) Then
With Ctrl
.Value = "MM/DD/YYYY"
.SelStart = 0
.SelLength = Len(.Text)
End With
CheckDate = True
Else
TextBox1 = Format(CDate(Ctrl), "mm/dd/yyyy")
End If
End Function

[zoom38]

Thanks for the reply SamT, i am receiving a "User-Defined type not defined" error on the line


Private Function CheckDate(Ctrl As Forms.TextBox) As Boolean

Any ideas on the cause?

Gary

[SamT]

See my previous edited post

[zoom38]

Thanks SamT but it seems your code checks every keystroke and keeps the value at mm/dd/yyyy regardless of input. I tried modifying it but couldn't get it to work properly. I also would like to keep my date validation function if possible because of the pop up that explains the date entry error. Is it possible for you to take a look at my code on the attached spreadsheet and advise how to modify it to keep my date validation function and also keep the cursor in the textbox after a wrong entry is made? It seems that after my function turns out an error message (msgbox) the cursor moves to the next textbox and no matter what I try I can't stop it.

Gary

[SamT]

I tested that code on a simple form with one TextBox and one other control and it accepted any value,. If the value was not a date, it kept the focus on the textbox, otherwise it just formatted the date as you wanted and left the textbox to go to the next control.

the Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) is not triggered until the Textbox is exited, so I don't see how it could check every keystroke.


Your Sub TextBox1_KeyDown checks every keystroke...

Did you make any significant changes to the code?

OK, I looked at your CheckDates code, It returns no value therefore it is a Sub, even though you have called it a Function.

the VBA Function IsDate returns False on 2/30/16, but true on 2/29/16. That is, it checks for valid dates.
It returns true for 1/Jan/15, 1/janu/15, and 1/January/15. but false for 1/jannuary/15

IOW, the Isdate in my Function checks everything that your "Sub" does and then some. Your CheckDates fails if the User enters 2-1-16 or 1 feb 16, but IsDate doesn't.

The only thing missing from my Function is the MsgBox. Unless your form is for children under the age of 12, Users don't need to be told that Febuary only has 28 days, except in leap years it has 29.

My function is to be used with any Date TextBox merely by changing the Control passed to it. My Function doesn't care what form of valid date string is passed to it. "1/1/15," "1 jan 15," "01-01-15," and "jan 1, 15" all work.

If you want the Vacation Dates to always start at the beginning of the Work Week, that is also possible.

This version checks for "MM/DD/YYYY." it is not tested but should work as is. You may need to do a bit of syntax tweaking.
Private Function CheckDate(Ctrl As MSForms.TextBox) As Boolean
Select Case Ctrl
Case "MM/DD/YYYY"
Case IsDate(.Value)
TextBox1 = Format(CDate(Ctrl), "mm/dd/yyyy")
Case Else
With Ctrl
.Value = "MM/DD/YYYY"
.SelStart = 0
.SelLength = Len(.Text)
End With
CheckDate = True
MsgBox "Please reenter the date using the suggested Format."
End Select
End Function

Since the Function Returns False for valid dates and true for invalid dates you can test it in the TextBox sub and call the Save sub when appropriate. .Remember to set Cancel to True to keep the focus on the Control.

If Not CheckDate(TextBox-N) Then
CopyVacationPeriods
Else
Cancel = True
End If

[zoom38]

Thank you SamT i realized why I wanted to use my date validation/sub. With Cdate, if the date is entered by mistake such as 5/55, the function accepts it as a valid date and reverts it to 5/1/1955. However I used your code with some modification and it works fine. Its not pretty, but it works. I added msgboxes to alert for a wrong entry and for whatever reason the code seems to run twice so both msg boxes pop up after a wrong entry. I tried disabling events but couldn't get it to only go through once. Could you advise what I might need to add to stop this. Below is the modified code I am using.



Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = checkdate(Me.TextBox1)
If Not checkdate(TextBox1) Then
CopyVacationPeriods
Else
Cancel = True
End If
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = checkdate(Me.TextBox2)
If Not checkdate(TextBox2) Then
CopyVacationPeriods
Else
Cancel = True
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = checkdate(Me.TextBox3)
If Not checkdate(TextBox3) Then
CopyVacationPeriods
Else
Cancel = True
End If
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = checkdate(Me.TextBox4)
If Not checkdate(TextBox4) Then
CopyVacationPeriods
Else
Cancel = True
End If
End Sub
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
z = 5 'Optional Entry
Cancel = checkdate(Me.TextBox5)
If Not checkdate(TextBox5) Then
CopyVacationPeriods
Else
Cancel = True
End If
End Sub





Private Function checkdate(ctrl As MSForms.TextBox) As Boolean
If z = 5 And ctrl.Value = "MM/DD/YYYY" Then
GoTo a
End If
If Not IsDate(ctrl) Then
With ctrl
.Value = "MM/DD/YYYY"
.SelStart = 0
.SelLength = Len(.Text)
End With
checkdate = True
MsgBox "An invalid date was entered. Verify and try again. ", vbOKOnly, "Invalid Entry"
Exit Function
ElseIf Weekday(ctrl) <> 2 Then
With ctrl
.Value = "MM/DD/YYYY"
.SelStart = 0
.SelLength = Len(.Text)
End With
checkdate = True
MsgBox "That is not a Monday. Vacation periods begin on Mondays. Pleae verify and try again.", _
vbOKOnly, "Date Is Not a Monday"
Exit Function
End If
a:
Select Case ctrl
Case TextBox1
TextBox1 = Format(CDate(ctrl), "mm/dd/yyyy")
Case TextBox2
TextBox2 = Format(CDate(ctrl), "mm/dd/yyyy")
Case TextBox3
TextBox3 = Format(CDate(ctrl), "mm/dd/yyyy")
Case TextBox4
TextBox4 = Format(CDate(ctrl), "mm/dd/yyyy")
Case TextBox5
If ctrl = "MM/DD/YYYY" Then
Exit Function
Else
TextBox5 = Format(CDate(ctrl), "mm/dd/yyyy")
End If
End Select
End Function



Thank You
Gary

[SamT]

The Select Case Statement is only entered when z = 5 and the control is in the default state ("MM/DD/YYYY")

If the Ctrl value = "MM/DD/YYYY" then the first four Cases will result in an error

TextBox1 = Format(CDate("MM/DD/YYYY", "mm/dd/yyyy")

If the Ctrl is Textbox5 then the code will immediately exit the function

If ctrl = "MM/DD/YYYY" Then
Exit Function
Else

No where in the Select Case Statement is the Function set to True, So the code in the TextBox_Exit sub is changed then exited again.

I'm going to work on the Monday only issue now. Be Back later

[SamT]

I had to rearrange the logic

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1 = "MM/DD/YYYY" Then Exit Sub

If IsValidDate(TextBox1) Then
CopyVacationPeriods
Else
Cancel = True
End If
End Sub


Private Function IsValidDate(Ctrl As MSForms.TextBox) As Boolean

Const Mday As Long = 2
Dim TBoxDay As Long
Dim PreviousMonday As Date
Dim NextMonday As Date
Dim Choice As Long

If Not IsDate(Ctrl) Then
With Ctrl
.Value = "MM/DD/YYYY"
.SelStart = 0
.SelLength = Len(.Text)
End With
MsgBox "Please reenter the date using the suggested Format."
Exit Function
End If

TBoxDay = Weekday(CDate(Ctrl))
If TBoxDay = Mday Then
Ctrl = Format(CDate(Ctrl), "mm/dd/yyyy")
IsValidDate = True
Exit Function
End If

PreviousMonday = DateAdd("d", -(TBoxDay - Mday), Ctrl)
NextMonday = DateAdd("ww", 1, PreviousMonday)

Choice = MsgBox(Title:="Choose a Monday Date", Buttons:=vbYesNoCancel, _

Prompt:="The Date You entered is a " & WeekdayName(TBoxDay) & "." & vbCrLf & _
"You must select a Monday Date." & vbCrLf & vbCrLf & _

"The Monday before the Date you entered falls on " & PreviousMonday & vbCrLf & _
"The Monday after that is on " & NextMonday & vbCrLf & vbCrLf & _

"Press Yes to choose the Monday before the Date you entered." & vbCrLf & _
"or press No to choose the next monday." & vbCrLf & vbCrLf & _
"Press Cancel to enter a different Date")

Select Case Choice
Case vbYes
Ctrl = Format(PreviousMonday, "mm/dd/yyyy")
IsValidDate = True
Case vbNo
Ctrl = Format(NextMonday, "mm/dd/yyyy")
IsValidDate = True
Case Else
With Ctrl
.Value = "MM/DD/YYYY"
.SelStart = 0
.SelLength = Len(.Text)
End With
End Select
End Function

Now you just need some TextBox_Enter subs to preselect the "MM/DD/YYYY" text

[zoom38]

The Select Case Statement is only entered when z = 5 and the control is in the default state ("MM/DD/YYYY")

If the Ctrl value = "MM/DD/YYYY" then the first four Cases will result in an error

TextBox1 = Format(CDate("MM/DD/YYYY", "mm/dd/yyyy")

If the Ctrl is Textbox5 then the code will immediately exit the function

If ctrl = "MM/DD/YYYY" Then
Exit Function
Else

No where in the Select Case Statement is the Function set to True, So the code in the TextBox_Exit sub is changed then exited again.

I'm going to work on the Monday only issue now. Be Back later

Sam the Select Case Statement seemed to work as i intended. If there was a wrong entry in the first four textboxes (mandatory entry) it would not get to the select case but if there was a good entry it would go thru the Select Case as intended. It would also exit out of the 5th textbox (optional) if a correct date was entered or the value was "MM/DD/YYYY". I then added:


If Cancel = True Then
Exit Sub
End If

in each of the 5 textbox_exit subs as you suggested and it stopped going thru the code twice and only one error message would pop up for an incorrect entry as intended.

However, your last post with the Monday routine is awesome and works great. I'm going to use that one. :thumb
Thank you for taking the time to assist me in this. "Solved"


Gary