Can't set focus back to textbox after user error

[sharky12345]

I'm using this code for a Textbox event;

Private Sub TextDOB_AfterUpdate()

If TextDOB.Value = "" Then
Exit Sub
Else
If IsDate(Me.TextDOB.Value) Then
Me.Label5.Caption = Age(CDate(Me.TextDOB.Value), Date)
Else
Me.Label5.Caption = ""
Call MsgBox(TextDOB.Value & " is not a valid date of birth - please re-enter", vbCritical, "DOB error")
TextDOB.Value = ""
TextDOB.SetFocus
Cancel = True
Exit Sub
End If
End If

End Sub

The problem I am having is that is the user enters a date that isn't valid I want the cursor to go back into the Textbox so they can try again, but everything I have tried does not work.

For info, the Age function is here, just in case that has something to do with it;

Function Age(Date1 As Date, Date2 As Date) As String
Dim Y As Integer
Dim M As Integer
Dim D As Integer
Dim Temp1 As Date
Temp1 = DateSerial(Year(Date2), Month(Date1), Day(Date1))
Y = Year(Date2) - Year(Date1) + (Temp1 > Date2)
M = Month(Date2) - Month(Date1) - (12 * (Temp1 > Date2))
D = Day(Date2) - Day(Date1)
If D < 0 Then
M = M - 1
D = Day(DateSerial(Year(Date2), Month(Date2), 0)) + D
End If
Age = "Age: " & Y '& " years" ')" '& M & " months " & D & " days"
End Function

 

[jkpieterse]

Events like Exit, Enter and AfterUpdate prevent you from using setfocus properly I'm afraid. What I usually do is:

- Have a label somewhere on which I can show input errors
- Use change, keyup and mouseup events to trigger a generic validation routine
- The validation routine checks all controls and changes the color of the ones which are not compliant to red and adds a message to the error label box
- If all is well the OK, Save, ... button is enabled, otherwise it remains disabled

 

[Jaafar Tribak]

Or you could add a routine in a Standard module and call it using the OnTime Method as follows :

In a Standard Module: (Change the userform name to suit)

Public Sub FocusBack()
    UserForm1.TextDOB.SetFocus
End Sub

And in the Userform Module :

Private Sub TextDOB_AfterUpdate()
    If TextDOB.Value = "" Then
        Exit Sub
    Else
        If IsDate(Me.TextDOB.Value) Then
            Me.Label5.Caption = Age(CDate(Me.TextDOB.Value), Date)
        Else
            Me.Label5.Caption = ""
            Call MsgBox(TextDOB.Value & " is not a valid date of birth - please re-enter", vbCritical, "DOB error")
            TextDOB.Value = ""
            [COLOR=#0000ff][B]Application.OnTime Now, "FocusBack"[/B][/COLOR]
            Cancel = True
            Exit Sub
        End If
    End If
End Sub

 

[MrIfOnly]

Or use the BeforeUpdate event instead:

Private Sub TextDOB_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

If TextDOB.Value = "" Then
Exit Sub
Else
If IsDate(Me.TextDOB.Value) Then
Me.Label5.Caption = Age(CDate(Me.TextDOB.Value), Date)
Else
Me.Label5.Caption = ""
Call MsgBox(TextDOB.Value & " is not a valid date of birth - please re-enter", vbCritical, "DOB error")
TextDOB.Value = ""
Cancel = True
End If
End If
End Sub

The focus will remain on your textbox after cancel is set to true.

Regards,

CJ

 

[sharky12345]

Guys, thanks to all who replied - the response from CJ was the first one I saw and it works just fine.

Thanks to all!