complicated subform beforeupdate

D

deb

access 2003
mainform is f001Projectreview with subform f015KeyMilestones(PK ProjectID)

I am trying to accomplish the below notes with the below code.

It works well unless...
user selects KeyMilestonesSubID = 12 and does not enter UnitNo.
It prompts for UnitNo and auto changes UnitNo to 0 and also prompts for
AuctualDt
This is what I wanted.
Now if user changes their mind and selects KeyMilestonesSubID = 8
It still give user the msg - All Units can only be used with PM080 and
PM670(which is KeyMilestonesSubID 12 or 20). Must enter Actual Date or check
N/a if Quality Gate is not applicable.
Correct the entry, or press Esc to undo.

The problem is the user changed the KeyMilestonesSubID from 12 to 8 but the
code is not recognizing the change to the combobox. I tried requrying the
comboboxs but didn't help.

Please help... I am sure the code can be greatly simplified too. I am lost..

Private Sub Form_BeforeUpdate(Cancel As Integer)

'Only one KeyMilestonesSubID = 12(PM080) and KeyMilestonesSubID = 20(PM670)
per project
'All other KeyMilestonesSubID(MS) can have multiples
'KeyMilestonesSubID = 12(PM080) or KeyMilestonesSubID = 20(PM670) must have
UnitNo=0(All Units)
'All other KeyMilestonesSubID(MS) must have UnitNo selected, (UnitNo<>0(All
Units))
'If KeyMilestonesSubID = 12(PM080) or KeyMilestonesSubID = 20(PM670) then
QGateNA<>Yes
'All other KeyMilestonesSubID(MS)must either enter QGateNA=Yes or must enter
ActualDt,
' cannot have QGateNA=Yes and an ActualDt

Dim strMsg As String
Dim strWhere As String
Dim varResult As Variant
Dim ans As String

Me.KeyMilestonesSubID.Requery
Me.UnitNo.Requery
Me.QGateNA.Requery
Me.ActualDt.Requery

If ((Me.KeyMilestonesSubID = 12) And (UnitNo <> 0 Or IsNull(UnitNo))) Or
((Me.KeyMilestonesSubID = 20) And (UnitNo <> 0 Or IsNull(UnitNo))) Then
Me.KeyMilestonesSubID.Requery
Me.UnitNo.Requery
Me.QGateNA.Requery
Me.ActualDt.Requery
MsgBox "'All Units' must be selected for PM080 and PM670." &
vbCrLf & _
"'All Units' will now be entered automatically.", vbCritical,
"Invalid Data"
Me.UnitNo = 0
Else
Me.KeyMilestonesSubID.Requery
Me.UnitNo.Requery
Me.QGateNA.Requery
Me.ActualDt.Requery
If ((Me.KeyMilestonesSubID <> 12) Or (Me.KeyMilestonesSubID <> 20))
And UnitNo = 0 Then
strMsg = strMsg & "'All Units' can only be used with PM080 and
PM670." & vbCrLf & _
"Must use dropdown selection to enter specific Unit." & vbCrLf &
vbCrLf
Me.UnitNo.SetFocus
Cancel = True
End If
End If

If ((Me.KeyMilestonesSubID <> 12) Or (Me.KeyMilestonesSubID <> 20)) And _
(IsNull(Me.QGateNA) Or (Me.QGateNA) = 0) And _
IsNull(ActualDt) Then
strMsg = strMsg & "Must enter Actual Date or" & vbCrLf & _
"check N/A if Quality Gate is not applicable." & vbCrLf & vbCrLf
Cancel = True
Else
If ((Me.KeyMilestonesSubID = 12) Or (Me.KeyMilestonesSubID = 20))
And _
(Me.QGateNA) <> 0 Then
strMsg = strMsg & "Cannot check 'N/A' if Quality Qate is PM670
or PM080 " & vbCrLf & _
"and 'Actual Date' must not be blank." & vbCrLf & vbCrLf
Cancel = True
End If
End If


If (Me.QGateNA) <> 0 And Not IsNull(ActualDt) Then
Msg = "Must not enter Actual Date if 'N/A' is checked. " &
vbCrLf & _
"'N/A' or 'Actual Date' must be removed." & vbCrLf & _
vbCr & vbCr & "Remove Actual Date?"
ans = MsgBox(Msg, vbCritical + vbYesNo, "Invalid Data")
If ans = vbNo Then
Me.QGateNA = 0
MsgBox "N/A has been unchecked.", , "Invalid Data"
Exit Sub
Else
Me.ActualDt = Null
End If
End If


If IsNull(Me.UnitNo) Then
Cancel = True
strMsg = strMsg & "Must use dropdown selection to enter Unit." &
vbCrLf
End If

If IsNull(Me.KeyMilestonesSubID) Then
Cancel = True
strMsg = strMsg & "Must use dropdown selection to enter Quality
Gate." & vbCrLf
End If


If ((Me.KeyMilestonesSubID) = 12 Or (Me.KeyMilestonesSubID) = 20) Then
strWhere = "([ProjectID] = " & Nz(Me.ProjectID, 0) & _
") AND ([KeyMilestonesSubID] = " & Nz(Me.KeyMilestonesSubID, 0)
& ")"
varResult = DLookup("[KeyMilestonesID]", "[t51KeyMilestones]",
strWhere)

If Not IsNull(varResult) Then
MsgBox "Duplicate Entry." & vbCrLf & vbCrLf & _
"There can only be one PM080 and PM670 per project.", vbExclamation,
"Duplicate entry"
Cancel = True
End If
End If


If Cancel Then
strMsg = strMsg & vbCrLf & "Correct the entry, or press Esc to undo."
MsgBox strMsg, vbExclamation, "Invalid data"
End If


If ((Me.KeyMilestonesSubID = 20) Or (Me.KeyMilestonesSubID = 12)) And
UnitNo <> 0 Then
Me.UnitNo = 0
End If


End Sub
 
D

deb

I figured it out, I think...
--
deb


deb said:
access 2003
mainform is f001Projectreview with subform f015KeyMilestones(PK ProjectID)

I am trying to accomplish the below notes with the below code.

It works well unless...
user selects KeyMilestonesSubID = 12 and does not enter UnitNo.
It prompts for UnitNo and auto changes UnitNo to 0 and also prompts for
AuctualDt
This is what I wanted.
Now if user changes their mind and selects KeyMilestonesSubID = 8
It still give user the msg - All Units can only be used with PM080 and
PM670(which is KeyMilestonesSubID 12 or 20). Must enter Actual Date or check
N/a if Quality Gate is not applicable.
Correct the entry, or press Esc to undo.

The problem is the user changed the KeyMilestonesSubID from 12 to 8 but the
code is not recognizing the change to the combobox. I tried requrying the
comboboxs but didn't help.

Please help... I am sure the code can be greatly simplified too. I am lost..

Private Sub Form_BeforeUpdate(Cancel As Integer)

'Only one KeyMilestonesSubID = 12(PM080) and KeyMilestonesSubID = 20(PM670)
per project
'All other KeyMilestonesSubID(MS) can have multiples
'KeyMilestonesSubID = 12(PM080) or KeyMilestonesSubID = 20(PM670) must have
UnitNo=0(All Units)
'All other KeyMilestonesSubID(MS) must have UnitNo selected, (UnitNo<>0(All
Units))
'If KeyMilestonesSubID = 12(PM080) or KeyMilestonesSubID = 20(PM670) then
QGateNA<>Yes
'All other KeyMilestonesSubID(MS)must either enter QGateNA=Yes or must enter
ActualDt,
' cannot have QGateNA=Yes and an ActualDt

Dim strMsg As String
Dim strWhere As String
Dim varResult As Variant
Dim ans As String

Me.KeyMilestonesSubID.Requery
Me.UnitNo.Requery
Me.QGateNA.Requery
Me.ActualDt.Requery

If ((Me.KeyMilestonesSubID = 12) And (UnitNo <> 0 Or IsNull(UnitNo))) Or
((Me.KeyMilestonesSubID = 20) And (UnitNo <> 0 Or IsNull(UnitNo))) Then
Me.KeyMilestonesSubID.Requery
Me.UnitNo.Requery
Me.QGateNA.Requery
Me.ActualDt.Requery
MsgBox "'All Units' must be selected for PM080 and PM670." &
vbCrLf & _
"'All Units' will now be entered automatically.", vbCritical,
"Invalid Data"
Me.UnitNo = 0
Else
Me.KeyMilestonesSubID.Requery
Me.UnitNo.Requery
Me.QGateNA.Requery
Me.ActualDt.Requery
If ((Me.KeyMilestonesSubID <> 12) Or (Me.KeyMilestonesSubID <> 20))
And UnitNo = 0 Then
strMsg = strMsg & "'All Units' can only be used with PM080 and
PM670." & vbCrLf & _
"Must use dropdown selection to enter specific Unit." & vbCrLf &
vbCrLf
Me.UnitNo.SetFocus
Cancel = True
End If
End If

If ((Me.KeyMilestonesSubID <> 12) Or (Me.KeyMilestonesSubID <> 20)) And _
(IsNull(Me.QGateNA) Or (Me.QGateNA) = 0) And _
IsNull(ActualDt) Then
strMsg = strMsg & "Must enter Actual Date or" & vbCrLf & _
"check N/A if Quality Gate is not applicable." & vbCrLf & vbCrLf
Cancel = True
Else
If ((Me.KeyMilestonesSubID = 12) Or (Me.KeyMilestonesSubID = 20))
And _
(Me.QGateNA) <> 0 Then
strMsg = strMsg & "Cannot check 'N/A' if Quality Qate is PM670
or PM080 " & vbCrLf & _
"and 'Actual Date' must not be blank." & vbCrLf & vbCrLf
Cancel = True
End If
End If


If (Me.QGateNA) <> 0 And Not IsNull(ActualDt) Then
Msg = "Must not enter Actual Date if 'N/A' is checked. " &
vbCrLf & _
"'N/A' or 'Actual Date' must be removed." & vbCrLf & _
vbCr & vbCr & "Remove Actual Date?"
ans = MsgBox(Msg, vbCritical + vbYesNo, "Invalid Data")
If ans = vbNo Then
Me.QGateNA = 0
MsgBox "N/A has been unchecked.", , "Invalid Data"
Exit Sub
Else
Me.ActualDt = Null
End If
End If


If IsNull(Me.UnitNo) Then
Cancel = True
strMsg = strMsg & "Must use dropdown selection to enter Unit." &
vbCrLf
End If

If IsNull(Me.KeyMilestonesSubID) Then
Cancel = True
strMsg = strMsg & "Must use dropdown selection to enter Quality
Gate." & vbCrLf
End If


If ((Me.KeyMilestonesSubID) = 12 Or (Me.KeyMilestonesSubID) = 20) Then
strWhere = "([ProjectID] = " & Nz(Me.ProjectID, 0) & _
") AND ([KeyMilestonesSubID] = " & Nz(Me.KeyMilestonesSubID, 0)
& ")"
varResult = DLookup("[KeyMilestonesID]", "[t51KeyMilestones]",
strWhere)

If Not IsNull(varResult) Then
MsgBox "Duplicate Entry." & vbCrLf & vbCrLf & _
"There can only be one PM080 and PM670 per project.", vbExclamation,
"Duplicate entry"
Cancel = True
End If
End If


If Cancel Then
strMsg = strMsg & vbCrLf & "Correct the entry, or press Esc to undo."
MsgBox strMsg, vbExclamation, "Invalid data"
End If


If ((Me.KeyMilestonesSubID = 20) Or (Me.KeyMilestonesSubID = 12)) And
UnitNo <> 0 Then
Me.UnitNo = 0
End If


End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

triggers duplicate msg if change is made 2
show if has two specific records 3
query help 1
Combo's beforeupdate and oldvalue 1
Spell Check button issue with subform 2
"Not in list" event code 2
"Not in list" event code 2
Validation Rule Code Help 3

Top