Found this on here but getting compile error??

[newbyvba]

I wanted some code to verify users had entered info in some fields on a form. This code looks perfect but i'm getting an error saying: compile error: next without For... whats wrong please?

Dim Msg As String, Style As Integer, Title As String
Dim DL As String, ctl As Control

DL = vbNewLine & vbNewLine

For Each ctl In Me.Controls

If ctl.Tag = "?" Then
If IsNull(ctl) Then
Msg = "'" & ctl.Name & "' is required and can't " & _
"be left blank!" & DL & _
"Go back and enter some data! . . ."
Style = vbInformation + vbOKOnly
Title = "Missing Required Data Error! . . ."
MsgBox Msg, Style, Title
Cancel = True
ctl.SetFocus
Exit For
End If
Next

 

[newbyvba]

Sorry: this is the exact sub I have:
Private Sub Form_BeforeUpdate(Cancel As Integer)
' check field for * in tag and check if text entered and provide error
Dim Msg As String, Style As Integer, Title As String
Dim DL As String, ctl As Control

DL = vbNewLine & vbNewLine

For Each ctl In Me.Controls
If ctl.Tag = "*" Then
If IsNull(ctl) Then
Msg = "'" & ctl.Name & "' is required and can't " & _
"be left blank!" & DL & _
"please go back and enter some data! . . ."
Style = vbInformation + vbOKOnly
Title = "Missing Required Data Error! . . ."
MsgBox Msg, Style, Title
Cancel = True
ctl.SetFocus
Exit For
End If
Next
End Sub

 

[PHV]

In fact there is a lack of one End If

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[newbyvba]

Oh thanks. Yes I see - I've put another End If in there but now I get the msgbox pop up but when I click ok I'm now getting the following: Microsoft Visual Basic; runtime error '3021' No current record... any ideas please?

 

[MazeWorX]

i would try this

Private Sub Form_BeforeUpdate(Cancel As Integer)
' check field for * in tag and check if text entered and provide error
    Dim Msg As String, Style As Integer, Title As String
    Dim DL As String, ctl As Control

    DL = vbNewLine & vbNewLine

    For Each ctl In Me.Controls
        If ctl.Tag = "*" Then
            If ctl.Value = Null Or ctl.Value = "" Then
                Msg = "'" & ctl.Name & "' is required and can't " & _
                      "be left blank!" & DL & _
                      "please go back and enter some data! . . ."
                Style = vbInformation + vbOKOnly
                Title = "Missing Required Data Error! . . ."
                MsgBox Msg, Style, Title
                ctl.SetFocus
                Exit For
            End If
        End If
    Next
End Sub

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[TheAceMan1]

Howdy [blue]MazeWorX[/blue] . . .

And what of the needed [blue]Cancel = True[/blue] line?

See Ya! . . . . . .

Be sure to see faq219-2884 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[MazeWorX]

no need the op actually had it there i forgot to delete it.It does nothing since its an ok only button

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[PHV]

Maze, the Cancel=True is needed in order to cancel the update.

 

[newbyvba]

I've incorporated the code MaZeWorX suggested but on entering the data, i'm not getting any validation happening at all! Have I missed something.. incase anyone has nothing better to do, i've pasted the code against the form should there be any glaring reason its not working.. or perhaps its something else i've overlooked..THANK YOU for any help..

Option Compare Database



Private Sub prodtypechoice_AfterUpdate()
'refresh the product choice based on the product type
Me.prodchoice.Requery
End Sub


Private Sub cmd_cancelinput_Click()
'Abandon adding new record and close input form
If Me.NewRecord Then
If MsgBox("Are you sure you wish to cancel record", 36, " Continue?") = vbYes Then

Me.Undo
DoCmd.Close
End If
End If

Exit_cmdcancelinput_Click:
Exit Sub

Err_cmdcancelinput_Click:
MsgBox Err.Description
Resume Exit_cmdcancelinput_Click

End Sub

Private Sub cmd_process_record_Click()
'refresh data input to check all data entered
Form_frm_report_req.Requery
End Sub

Private Sub cmdaddnewclient_Click()
'command button to go to form to add new client detail
On Error GoTo Err_cmdaddnewclient_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frm_client"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmdaddnewclient_Click:
Exit Sub

Err_cmdaddnewclient_Click:
MsgBox Err.Description
Resume Exit_cmdaddnewclient_Click

End Sub

Private Sub Comboclient1_Click()
' refresh after adding new client to client form
Me.Comboclient1.Requery
End Sub

Private Sub Comboinvestment_type_AfterUpdate()
'If other investment choice, then make the text box to enter details visible
If Me!Comboinvestment_type = 4 Then
Me!other_inv_type.Visible = True
MsgBox ("You have chose an investment type of other. Please enter the type of investment below")
Else
Me!other_inv_type.Visible = False
End If
End Sub

Private Sub Comboobjective_AfterUpdate()
'dependent on the objective chosen, makes term or ret age visible
Me.term_text.Visible = False
Me.Retirement_Age.Visible = False

Select Case Me.Comboobjective
Case 9, 10
MsgBox ("Please select the TFC check box and enter a TFC reason. Also enter the retirement age.")
Me.Retirement_Age.Visible = True
Case 1, 2, 3, 5, 8
Me.term_text.Visible = True
MsgBox "Please enter term information"
Case 4, 6, 7, 9, 10
Me.Retirement_Age.Visible = True
MsgBox "Please enter retirement age"
Case Else
MsgBox ("Choose an objective")
End Select

End Sub

Private Sub Comboprod_type_AfterUpdate()
'refresh the products list after choosing the product type
Me.Comboproduct.Requery
End Sub

Private Sub cmdnewreq_Click()
'command button to add another new request
On Error GoTo Err_cmdnewreq_Click


DoCmd.GoToRecord , , acNewRec

Exit_cmdnewreq_Click:
Exit Sub

Err_cmdnewreq_Click:
MsgBox Err.Description
Resume Exit_cmdnewreq_Click

End Sub

Private Sub Combotfc_reason_AfterUpdate()
' if reason for TFC is cash, then prompt user to add additional information
If Me!Combotfc_reason = 1 Then
MsgBox ("Please enter a reason for Urgent Cash Required in the Additional Information")
End If
End Sub


Private Sub Form_BeforeUpdate(Cancel As Integer)
' check field for * in tag and check if text entered and provide error
Dim Msg As String, Style As Integer, Title As String
Dim DL As String, ctl As Control

DL = vbNewLine & vbNewLine

For Each ctl In Me.Controls
If ctl.Tag = "*" Then
If ctl.Value = Null Or ctl.Value = "" Then
Msg = "'" & ctl.Name & "' is required and can't " & _
"be left blank!" & DL & _
"please go back and enter some data! . . ."
Style = vbInformation + vbOKOnly
Title = "Missing Required Data Error! . . ."
MsgBox Msg, Style, Title
ctl.SetFocus
Exit For
End If
End If
Next

End Sub


Private Sub Form_Open(Cancel As Integer)
' stops the mouse wheel going to next record
Static MouseHook As Object
Set MouseHook = NewMouseHook(Me)
End Sub



Private Sub high_priority_AfterUpdate()
' If user chooses the high priority then the reason becomes visible and prompts user to complete
If Me!high_priority.Value = True Then
Me!Comboreason.Visible = True
MsgBox ("Please select a reason for the high priority")
Else
Me!Comboreason.Visible = False
End If
End Sub


Private Sub prot_tfc_AfterUpdate()
' If the protected TFC checkbox is selected, make the amount visible and prompt user to enter
If Me!prot_tfc.Value = True Then
Me!prot_amount.Visible = True
MsgBox ("When Protected TFC selected, please enter a protected amount")
Else
Me!prot_amount.Visible = False
End If
End Sub

Private Sub tfc_AfterUpdate()
' If the tfc checkbox selected, make list of TFC reasons visible and prompt user to complete
If Me!tfc.Value = True Then
Me!Combotfc_reason.Visible = True
MsgBox ("When TFC Taken is selected, please enter a TFC Reason")
Else
Me!Combotfc_reason.Visible = False
End If

End Sub

Private Sub cmd_main_Click()
' exit the form to the main menu

If Me.Dirty Then Me.Dirty = False
DoCmd.Close

End Sub

 

[MazeWorX]

opps didnt even realize the code was a before update "Form_BeforeUpdate(Cancel As Integer)" As it has glaringly been pointed out to me did you re add the Cancel = True line? Sorry about that sometimes i can be a real noob

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[newbyvba]

Hello MazeWorX
I've added the line Cancel = true before the ctl.getfocus line
However, nothing is happening when no data is entered for the tagged fields. Any idea why?
Thanks so much - this is very frustrating!

 

[PHV]

Any idea why?
Sure, nothing can be equal Null
So, replace this:
If ctl.Value = Null
with this:
If IsNull(ctl.Value)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[MazeWorX]

Sorry PHV is correct I posted a pc of code while thinking of setting a value to null(combination of both) instead of checking the value however here is a chunk of code i use for the same purpose should solve your issue regardless if its null or an empty string note the [red]If Trim(ctl.Value & "") = "" Then[/red] line. By adding an empty string to the value we then only need to check for empty string values

Private Sub cmdSave_Click()
    On Error GoTo Err_CmdSave_Click
    
    Dim txtMessage As String
    Dim ctl As Control
    
    For Each ctl In Me.Controls
        If ctl.Tag = "Needed" Then
            If Trim(ctl.Value & "") = "" Then
                'Highlight missing data fields
                Me(ctl.Name).BackColor = vbYellow
                blnError = True
            Else
                Me(ctl.Name).BackColor = vbWhite
            End If
        End If
    Next

    If blnError = True Then
        txtMessage = "All Required fields must be entered before the record can be added." & vbNewLine & _
                     "Please enter a value for the highlighted fields"
        MsgBox txtMessage, vbOKOnly
    Else
'go on to save the record

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[TheAceMan1]

newbyvba . . .

Soooo ... where are you with this?

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

Be sure to see faq219-2884 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]