Error Handling Routine

K

kenrmcl

G'day there One & All,

I have a Userform in a project I'm working on that contains 3 tex
boxes whose contents are fields in a record to add to a list. It work
just fine except for one annoying problem. I have an error checkin
function that I call when a button is clicked on the form. This check
for a blank entry (all 3 text boxes must have an entry), and correc
formatting of the first text box which must be either 4 or 5 digits.

If these conditions aren't met then a MsgBox alerts the user
That's where my problem begins. When the user clicks the MsgBox, i
disappears and so does the userform. I'd like the userform to remain s
that the user can correct the fault condition.

I have the userform built in the VBE, I don't construct i
programmatically. The code for the UserForm "Enter" button run
thusly:

Private Sub CommandButton1_Click()

Set up variables
Run some stuff

test = CheckOfficer(offNum.Text, offName.Text, offRank.Text)
If test = False Then
End If

(I've not yet got anything between "Then" & "end If". I thin
that's probably what I'm asking for)

Run more stuff

End Sub

I've got the errorchecking bit to return "False" if there's an error
and "True" if not. If there is an error then it shows the appropriat
MsgBox (I've got that bit working OK), but on clicking the "OK" butto
it clears the MsgBox, the UserForm, and then stores the dud recor
anyway.

How can I get it to leave the Userform up for correction?

I'll be happy to post the full code if need be.

See ya
and Thanks
Ken McLenna
 
B

Bob Phillips

It sounds as though you are exiting regardless of the msgbox answer, but I
think it would help to see all the code to see how and why.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
K

kenrmcl

G'day there Bob,

It sounds as though you are exiting regardless of the msgbox answer
but I
think it would help to see all the code to see how and why.

You've hit the nail on the head, but I can't figure out how to ge
around it. Here's the code for the two routines:

Option Explicit
Private Sub CommandButton1_Click()
' Add Officer

Dim shData As Worksheet
Dim newRow As Integer
Dim msg, response As String
Dim test As String

' Assignments
Set shData = Worksheets("Data")
newRow = Worksheets("Main").Range("OfficerMaxRows").Value + 1

[ The 'newrow' above gets the next row for record entry from a functio
in the named range "OfficerMaxRows" on the "Data" worksheet]

shData.Activate

test = CheckOfficer(offNum.Text, offName.Text, offRank.Text)
If test = False Then

[I think this is where I have to put something to return to the star
of the sub if the test fails]

End If

'Insert record
shData.Cells(newRow, 1) = offNum.Text
shData.Cells(newRow, 2) = UCase(offName.Text)
shData.Cells(newRow, 3) = offRank.Text

shData.Range("Officer_Data").Sort _
Key1:=Worksheets("data").Columns("A")

Worksheets("Main").Range("P2").Calculate

frmAdmin.Hide
Worksheets("Main").Activate


End Sub

Private Function CheckOfficer(x, y, z)
' Data validation & error detection on entry of New Officer records
' Officer number must be in the format of 4 or 5 digits
' There can be no duplicates in this field
Dim a As Integer
Dim err(4, 1) As String
Dim bttn As Integer
Dim hdr As String
Dim dummy As Integer

err(0, 0) = Worksheets("Main").Range("AA2").Text
err(0, 1) = Worksheets("Main").Range("AB2").Text
err(1, 0) = Worksheets("Main").Range("AA3").Text
err(1, 1) = Worksheets("Main").Range("AB3").Text
err(2, 0) = Worksheets("Main").Range("AA4").Text
err(2, 1) = Worksheets("Main").Range("AB4").Text
err(3, 0) = Worksheets("Main").Range("AA5").Text
err(3, 1) = Worksheets("Main").Range("AB5").Text

a = (Len(x) * Len(y) * Len(z))
CheckOfficer = True
Select Case a
Case False
'Raise Blank Field error
CheckOfficer = False
dummy = MsgBox(err(0, 0), 0 + vbCritical, err(0, 1))
Case Else
' Too few characters in Officer number
If (Len(x) < 4) Then
CheckOfficer = False
dummy = MsgBox(err(1, 0), 0 + vbCritical, err(1, 1))
End If
' Too many characters in Officer number
If (Len(x) > 5) Then
CheckOfficer = False
dummy = MsgBox(err(2, 0), 0 + vbCritical, err(2, 1))
End If
' Officer number is not a number
If Not IsNumeric(frmAdmin.offNum.Text) Then
CheckOfficer = False
dummy = MsgBox(err(3, 0), 0 + vbCritical, err(3, 1))
End If
End Select
frmAdmin.offNum.SetFocus

End Function


Hope it all makes sense.

See ya
Ke
 
B

Bob Phillips

G'day yourself Ken,

Try this variation

Option Explicit

Private Sub CommandButton1_Click()
' Add Officer

Dim shData As Worksheet
Dim newRow As Integer
Dim msg, response As String
Dim test As String

' Assignments
Set shData = Worksheets("Data")
newRow = Worksheets("Main").Range("OfficerMaxRows").Value + 1

shData.Activate

If CheckOfficer(offNum.Text, offName.Text, offRank.Text) Then

'Insert record
shData.Cells(newRow, 1) = offNum.Text
shData.Cells(newRow, 2) = UCase(offName.Text)
shData.Cells(newRow, 3) = offRank.Text

shData.Range("Officer_Data").Sort _
Key1:=Worksheets("data").Columns("A")

Worksheets("Main").Range("P2").Calculate

frmAdmin.Hide
Worksheets("Main").Activate

End If

End Sub

Private Function CheckOfficer(x, y, z)
' Data validation & error detection on entry of New Officer records
' Officer number must be in the format of 4 or 5 digits
' There can be no duplicates in this field
Dim a As Integer
Dim err(4, 1) As String
Dim bttn As Integer
Dim hdr As String
Dim dummy As Integer

err(0, 0) = Worksheets("Main").Range("AA2").Text
err(0, 1) = Worksheets("Main").Range("AB2").Text
err(1, 0) = Worksheets("Main").Range("AA3").Text
err(1, 1) = Worksheets("Main").Range("AB3").Text
err(2, 0) = Worksheets("Main").Range("AA4").Text
err(2, 1) = Worksheets("Main").Range("AB4").Text
err(3, 0) = Worksheets("Main").Range("AA5").Text
err(3, 1) = Worksheets("Main").Range("AB5").Text

a = (Len(x) * Len(y) * Len(z))
CheckOfficer = True
Select Case a
Case False
'Raise Blank Field error
CheckOfficer = False
dummy = MsgBox(err(0, 0), 0 + vbCritical, err(0, 1))
Case Else
' Too few characters in Officer number
If (Len(x) < 4) Then
CheckOfficer = False
dummy = MsgBox(err(1, 0), 0 + vbCritical, err(1, 1))
' Too many characters in Officer number
ElseIf (Len(x) > 5) Then
CheckOfficer = False
dummy = MsgBox(err(2, 0), 0 + vbCritical, err(2, 1))
' Officer number is not a number
ElseIf Not IsNumeric(frmAdmin.offNum.Text) Then
CheckOfficer = False
dummy = MsgBox(err(3, 0), 0 + vbCritical, err(3, 1))
End If
End Select
With Me.offNum
.SelStart = 0
.SelLength = Len(.Text)
.SetFocus
End With

End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

kenrmcl > said:
G'day there Bob,

It sounds as though you are exiting regardless of the msgbox answer,
but I
think it would help to see all the code to see how and why.

You've hit the nail on the head, but I can't figure out how to get
around it. Here's the code for the two routines:

Option Explicit
Private Sub CommandButton1_Click()
' Add Officer

Dim shData As Worksheet
Dim newRow As Integer
Dim msg, response As String
Dim test As String

' Assignments
Set shData = Worksheets("Data")
newRow = Worksheets("Main").Range("OfficerMaxRows").Value + 1

[ The 'newrow' above gets the next row for record entry from a function
in the named range "OfficerMaxRows" on the "Data" worksheet]

shData.Activate

test = CheckOfficer(offNum.Text, offName.Text, offRank.Text)
If test = False Then

[I think this is where I have to put something to return to the start
of the sub if the test fails]

End If

'Insert record
shData.Cells(newRow, 1) = offNum.Text
shData.Cells(newRow, 2) = UCase(offName.Text)
shData.Cells(newRow, 3) = offRank.Text

shData.Range("Officer_Data").Sort _
Key1:=Worksheets("data").Columns("A")

Worksheets("Main").Range("P2").Calculate

frmAdmin.Hide
Worksheets("Main").Activate


End Sub

Private Function CheckOfficer(x, y, z)
' Data validation & error detection on entry of New Officer records
' Officer number must be in the format of 4 or 5 digits
' There can be no duplicates in this field
Dim a As Integer
Dim err(4, 1) As String
Dim bttn As Integer
Dim hdr As String
Dim dummy As Integer

err(0, 0) = Worksheets("Main").Range("AA2").Text
err(0, 1) = Worksheets("Main").Range("AB2").Text
err(1, 0) = Worksheets("Main").Range("AA3").Text
err(1, 1) = Worksheets("Main").Range("AB3").Text
err(2, 0) = Worksheets("Main").Range("AA4").Text
err(2, 1) = Worksheets("Main").Range("AB4").Text
err(3, 0) = Worksheets("Main").Range("AA5").Text
err(3, 1) = Worksheets("Main").Range("AB5").Text

a = (Len(x) * Len(y) * Len(z))
CheckOfficer = True
Select Case a
Case False
'Raise Blank Field error
CheckOfficer = False
dummy = MsgBox(err(0, 0), 0 + vbCritical, err(0, 1))
Case Else
' Too few characters in Officer number
If (Len(x) < 4) Then
CheckOfficer = False
dummy = MsgBox(err(1, 0), 0 + vbCritical, err(1, 1))
End If
' Too many characters in Officer number
If (Len(x) > 5) Then
CheckOfficer = False
dummy = MsgBox(err(2, 0), 0 + vbCritical, err(2, 1))
End If
' Officer number is not a number
If Not IsNumeric(frmAdmin.offNum.Text) Then
CheckOfficer = False
dummy = MsgBox(err(3, 0), 0 + vbCritical, err(3, 1))
End If
End Select
frmAdmin.offNum.SetFocus

End Function


Hope it all makes sense.

See ya
Ken
Click to expand...
 
K

kenrmcl

G'day there Bob,
G'day yourself Ken,

Try this variation
Click to expand...

FYI, you now have my undying gratitude. Your 'variation' worke
like a charm. I dunno why I didn't think of that for myself. Probabl
something to do with ineptitude =).

Thank you very muchly once more, and if you have a spare minute i
the day perhaps you could write my entire project but put my name a
the top so I can get the credit <g>.

...and, before I forget, exactly where is Poole Harbour & Th
Purbecks. And what are The Purbecks? If you feel like answering
perhaps off list might be better.

See ya, & despite my flippant response, I do greatly appreciate you
assistance.

Ken McLennan
Brisbane, Ql
 
Top