AfterUpdate event not firing

P

Pat

I have a Purchase Order system I am working on. The main from frmMaintainPO
has a subform sfrmPODetail that is a datasheet form. On the subform footer I
have a control that is the subtotal of the detail section. I am trying to
use the From_AfterUpdate event on the subform to update the main form's
Subtotal control. But the event will never fire. The BeforeUpdate will
fire, but the subtotal has not been updated yet.

Any help is appreciated.
 
R

ruralguy via AccessMonster.com

What version of Access? The SubForm's AfterUpdate event should fire when the
SubForm is Dirty and you move the focus back to the MainForm.
 
P

Pat

It's 2003. I thought so as well and in both cases you listed it does not. I
tried both a msgbox and traping in the debugger. Nethier seem to fire. I
can complete the entire record and tab to the next without the event firing,
however the beforeupdate will fire.

Strange.

Here is the src incase it helps.

Option Compare Database
Option Explicit


Private Function CalcTax() As Boolean
Dim dbLoc As DAO.Database, rsLoc As DAO.Recordset
Dim sSQL As String, lTax As Single

On Error GoTo err_CalcTax

If (IsNull(Me.Location)) Then
CalcTax = False
Exit Function
End If

If (Not Me.Taxable) Then
Me.txtTaxAmount = 0
CalcTax = True
Exit Function
End If
Set dbLoc = CurrentDb()
sSQL = "SELECT * FROM tblLocations WHERE PS_LOC='" _
& Me.Location & "';"
Set rsLoc = dbLoc.OpenRecordset(sSQL, dbOpenDynaset)
rsLoc.MoveLast
If (Not (rsLoc.BOF And rsLoc.EOF)) Then
lTax = rsLoc.Fields("Tax")
Me.txtTaxAmount = (Me.Extended * lTax)
CalcTax = True
End If

exit_CalcTax:
rsLoc.Close
dbLoc.Close
Set rsLoc = Nothing
Set dbLoc = Nothing
Exit Function

err_CalcTax:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In CalcTax", vbExclamation + vbOKOnly, Me.Name
Resume exit_CalcTax

End Function

Private Sub Form_AfterUpdate()
UpdateMiscFields
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant

If (Me.Qty = 0) Then
vResult = MsgBox("You have a QTY of 0 on line# " & Me.LineNbr & _
", Do you want to continue with a 0 Qty?", vbExclamation +
vbYesNo, "Qty Error")
If (vResult = vbNo) Then Cancel = True
Else
'vResult = UpdateMiscFields
Cancel = False
End If

End Sub

Private Sub Form_Open(Cancel As Integer)

On Error GoTo err_Form_Open

If (Not IsLoaded("frmMaintainPO")) Then
Cancel = True
Else
If (Me.Parent.Name <> "frmMaintainPO") Then Cancel = True
End If

If (Cancel) Then
MsgBox "For use from the frmMaintainPO Form only", _
vbOKOnly
Cancel = True
End If

exit_Form_Open:
Exit Sub

err_Form_Open:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Form_Open", vbExclamation + vbOKOnly, Me.Name
Resume exit_Form_Open

End Sub

Private Sub Location_AfterUpdate()
Dim vResult As Variant

On Error GoTo err_Location_AfterUpdate

If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
Me.PartNum.SetFocus

exit_Location_AfterUpdate:
Exit Sub

err_Location_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Location_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Location_AfterUpdate

End Sub

Private Sub Location_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant

If (Me.Location <> Me.Parent.Controls("ShipTo")) Then
vResult = MsgBox("The location is different than the ShipTo
specified on the Header." & vbCrLf & _
vbCrLf & "The location on the Lines is only used for accounting
purposes and will" & vbCrLf & _
"will not affect the shipment." & vbCrLf & vbCrLf, vbInformation
+ vbOKOnly, "Notice")
'
End If
End Sub

Private Sub PartNum_AfterUpdate()

On Error GoTo err_PartNum_AfterUpdate

Me.Cost.SetFocus

exit_PartNum_AfterUpdate:
Exit Sub

err_PartNum_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In PartNum_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_PartNum_AfterUpdate

End Sub

Private Sub PartNum_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant, LineNumber As Integer

'On Error GoTo err_PartNum_BeforeUpdate

bAbortItemAdd = False

If (Not GetPart) Then
vResult = MsgBox("Item """ & Me.PartNum & """ was not found!" _
& vbCrLf & "Do you want to add this item?", vbInformation +
vbYesNoCancel, _
"Not Found")
If (vResult = vbYes) Then
Do While (Not bAbortItemAdd)
DoCmd.OpenForm "frmMaintainItems", , , , acFormAdd,
acDialog, Me.PartNum
'DoCmd.OpenForm "frmMaintainItems", , , , acFormAdd, ,
Me.PartNum
If (Not bAbortItemAdd) Then
GetPart
Cancel = False
Else
Me.Undo
Cancel = True
End If
Loop
bAbortItemAdd = False ' reset var
Else
Cancel = True
End If
Else
If (Not VerifyVendor) Then
vResult = MsgBox("The item you entered '" & Me.PartNum & _
"' is in the item file under a different vendor." & _
vbCrLf & vbCrLf & "Do you want to keep this item on the
PO?", _
vbExclamation + vbYesNo, "Vendor Conflict")
If (vResult = vbNo) Then
Me.Undo
Cancel = True
End If
End If
If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
End If
If (Cancel = False) Then
' Update the Line Number
Me.LineNbr.Value = NextLineNbr(Me.POnum.Value)
End If

exit_PartNum_BeforeUpdate:
Exit Sub

err_PartNum_BeforeUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In PartNum_BeforeUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_PartNum_BeforeUpdate

End Sub

Function NextLineNbr(sPOnum As String) As Integer
Dim dbPO As DAO.Database, rsPO As DAO.Recordset
Dim sSQL As String

On Error GoTo err_NextLineNbr
Set dbPO = CurrentDb()
sSQL = "SELECT Max(tblPODetail.LineNbr) AS LastLineNbr " & _
"FROM tblPODetail " & _
"WHERE (((tblPODetail.PONum)='" & sPOnum & "'));"
Set rsPO = dbPO.OpenRecordset(sSQL, dbOpenDynaset)
If (IsNull(rsPO!LastLineNbr)) Then
NextLineNbr = 1
Else
NextLineNbr = (rsPO!LastLineNbr + 1)
End If

exit_NextLineNbr:
rsPO.Close
dbPO.Close
Set rsPO = Nothing
Set dbPO = Nothing
Exit Function

err_NextLineNbr:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In NextLineNbr", vbExclamation + vbOKOnly, Me.Name
Resume exit_NextLineNbr

End Function

Function VerifyVendor() As Boolean
Dim dbItem As DAO.Database, rsItem As DAO.Recordset
Dim sSQL As String, sVendor As String

On Error GoTo err_VerifyVendor

VerifyVendor = False
Set dbItem = CurrentDb()
sSQL = "SELECT * FROM tblItemFile WHERE PartNum='" & Me.PartNum & "';"
Set rsItem = dbItem.OpenRecordset(sSQL, dbOpenDynaset)
If ((Not (rsItem.BOF And rsItem.EOF)) And (rsItem.RecordCount > 0)) Then
rsItem.MoveLast
rsItem.MoveFirst
sVendor = Forms!frmMaintainPO.VendorID
If (sVendor = rsItem.Fields("VendorID")) Then
VerifyVendor = True
End If
End If

exit_VerifyVendor:
rsItem.Close
dbItem.Close
Set rsItem = Nothing
Set dbItem = Nothing
Exit Function

err_VerifyVendor:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In VerifyVendor", vbExclamation + vbOKOnly, Me.Name
Resume exit_VerifyVendor

End Function

Function GetPart() As Boolean
Dim dbItem As DAO.Database, rsItem As DAO.Recordset
Dim sSQL As String

On Error GoTo err_GetPart

Set dbItem = CurrentDb()
sSQL = "SELECT * FROM tblItemFile WHERE PartNum='" _
& Me.PartNum & "';"
Set rsItem = dbItem.OpenRecordset(sSQL, dbOpenDynaset)
If (Not (rsItem.BOF And rsItem.EOF)) Then
Me.Description = rsItem.Fields("Description")
Me.Cost = rsItem.Fields("Cost")
Me.Taxable = rsItem.Fields("Taxable")
GetPart = True
Else
GetPart = False
End If

exit_GetPart:
rsItem.Close
dbItem.Close
Set rsItem = Nothing
Set dbItem = Nothing
Exit Function

err_GetPart:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In GetPart", vbExclamation + vbOKOnly, Me.Name
Resume exit_GetPart

End Function


Private Sub Qty_AfterUpdate()
Dim vResult As Variant

On Error GoTo err_Qty_AfterUpdate

If (Me.Qty > 0 And Me.Cost > 0) Then
Me.Extended = (Me.Qty * Me.Cost)
Else
Me.Extended = 0
End If

If (IsNull(Me.Qty) Or IsNull(Me.Cost)) Then
Me.Extended = 0
End If

If ((Me.Extended.OldValue <> Me.Extended.Value) Or
(IsNull(Me.Extended.OldValue))) Then
If (CalcTax = False) Then
MsgBox "Error calculating the tax. Please verify your entry", _
vbExclamation + vbOKOnly, "Tax Error"
End If
End If

exit_Qty_AfterUpdate:
Exit Sub

err_Qty_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Qty_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Qty_AfterUpdate

End Sub



Private Sub Taxable_AfterUpdate()
Dim vResult As Variant

If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If

On Error GoTo err_Taxable_AfterUpdate

exit_Taxable_AfterUpdate:
Exit Sub

err_Taxable_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Taxable_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Taxable_AfterUpdate

End Sub

Private Function UpdateMiscFields() As Boolean

' If (Me.NewRecord) Then
' Me!Received = False
' Else
Application.Forms(Me.Parent.Name).UpdatePOFooter
If (Err.Number <> 0) Then
UpdateMiscFields = True
Else
UpdateMiscFields = False
End If
' End If
End Function
 
R

ruralguy via AccessMonster.com

Pat,
Any chance you can upload your db to one of the free file hosting sites?
Remove any sensitive data of course.
It's 2003. I thought so as well and in both cases you listed it does not. I
tried both a msgbox and traping in the debugger. Nethier seem to fire. I
can complete the entire record and tab to the next without the event firing,
however the beforeupdate will fire.

Strange.

Here is the src incase it helps.

Option Compare Database
Option Explicit

Private Function CalcTax() As Boolean
Dim dbLoc As DAO.Database, rsLoc As DAO.Recordset
Dim sSQL As String, lTax As Single

On Error GoTo err_CalcTax

If (IsNull(Me.Location)) Then
CalcTax = False
Exit Function
End If

If (Not Me.Taxable) Then
Me.txtTaxAmount = 0
CalcTax = True
Exit Function
End If
Set dbLoc = CurrentDb()
sSQL = "SELECT * FROM tblLocations WHERE PS_LOC='" _
& Me.Location & "';"
Set rsLoc = dbLoc.OpenRecordset(sSQL, dbOpenDynaset)
rsLoc.MoveLast
If (Not (rsLoc.BOF And rsLoc.EOF)) Then
lTax = rsLoc.Fields("Tax")
Me.txtTaxAmount = (Me.Extended * lTax)
CalcTax = True
End If

exit_CalcTax:
rsLoc.Close
dbLoc.Close
Set rsLoc = Nothing
Set dbLoc = Nothing
Exit Function

err_CalcTax:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In CalcTax", vbExclamation + vbOKOnly, Me.Name
Resume exit_CalcTax

End Function

Private Sub Form_AfterUpdate()
UpdateMiscFields
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant

If (Me.Qty = 0) Then
vResult = MsgBox("You have a QTY of 0 on line# " & Me.LineNbr & _
", Do you want to continue with a 0 Qty?", vbExclamation +
vbYesNo, "Qty Error")
If (vResult = vbNo) Then Cancel = True
Else
'vResult = UpdateMiscFields
Cancel = False
End If

End Sub

Private Sub Form_Open(Cancel As Integer)

On Error GoTo err_Form_Open

If (Not IsLoaded("frmMaintainPO")) Then
Cancel = True
Else
If (Me.Parent.Name <> "frmMaintainPO") Then Cancel = True
End If

If (Cancel) Then
MsgBox "For use from the frmMaintainPO Form only", _
vbOKOnly
Cancel = True
End If

exit_Form_Open:
Exit Sub

err_Form_Open:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Form_Open", vbExclamation + vbOKOnly, Me.Name
Resume exit_Form_Open

End Sub

Private Sub Location_AfterUpdate()
Dim vResult As Variant

On Error GoTo err_Location_AfterUpdate

If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
Me.PartNum.SetFocus

exit_Location_AfterUpdate:
Exit Sub

err_Location_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Location_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Location_AfterUpdate

End Sub

Private Sub Location_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant

If (Me.Location <> Me.Parent.Controls("ShipTo")) Then
vResult = MsgBox("The location is different than the ShipTo
specified on the Header." & vbCrLf & _
vbCrLf & "The location on the Lines is only used for accounting
purposes and will" & vbCrLf & _
"will not affect the shipment." & vbCrLf & vbCrLf, vbInformation
+ vbOKOnly, "Notice")
'
End If
End Sub

Private Sub PartNum_AfterUpdate()

On Error GoTo err_PartNum_AfterUpdate

Me.Cost.SetFocus

exit_PartNum_AfterUpdate:
Exit Sub

err_PartNum_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In PartNum_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_PartNum_AfterUpdate

End Sub

Private Sub PartNum_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant, LineNumber As Integer

'On Error GoTo err_PartNum_BeforeUpdate

bAbortItemAdd = False

If (Not GetPart) Then
vResult = MsgBox("Item """ & Me.PartNum & """ was not found!" _
& vbCrLf & "Do you want to add this item?", vbInformation +
vbYesNoCancel, _
"Not Found")
If (vResult = vbYes) Then
Do While (Not bAbortItemAdd)
DoCmd.OpenForm "frmMaintainItems", , , , acFormAdd,
acDialog, Me.PartNum
'DoCmd.OpenForm "frmMaintainItems", , , , acFormAdd, ,
Me.PartNum
If (Not bAbortItemAdd) Then
GetPart
Cancel = False
Else
Me.Undo
Cancel = True
End If
Loop
bAbortItemAdd = False ' reset var
Else
Cancel = True
End If
Else
If (Not VerifyVendor) Then
vResult = MsgBox("The item you entered '" & Me.PartNum & _
"' is in the item file under a different vendor." & _
vbCrLf & vbCrLf & "Do you want to keep this item on the
PO?", _
vbExclamation + vbYesNo, "Vendor Conflict")
If (vResult = vbNo) Then
Me.Undo
Cancel = True
End If
End If
If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
End If
If (Cancel = False) Then
' Update the Line Number
Me.LineNbr.Value = NextLineNbr(Me.POnum.Value)
End If

exit_PartNum_BeforeUpdate:
Exit Sub

err_PartNum_BeforeUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In PartNum_BeforeUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_PartNum_BeforeUpdate

End Sub

Function NextLineNbr(sPOnum As String) As Integer
Dim dbPO As DAO.Database, rsPO As DAO.Recordset
Dim sSQL As String

On Error GoTo err_NextLineNbr
Set dbPO = CurrentDb()
sSQL = "SELECT Max(tblPODetail.LineNbr) AS LastLineNbr " & _
"FROM tblPODetail " & _
"WHERE (((tblPODetail.PONum)='" & sPOnum & "'));"
Set rsPO = dbPO.OpenRecordset(sSQL, dbOpenDynaset)
If (IsNull(rsPO!LastLineNbr)) Then
NextLineNbr = 1
Else
NextLineNbr = (rsPO!LastLineNbr + 1)
End If

exit_NextLineNbr:
rsPO.Close
dbPO.Close
Set rsPO = Nothing
Set dbPO = Nothing
Exit Function

err_NextLineNbr:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In NextLineNbr", vbExclamation + vbOKOnly, Me.Name
Resume exit_NextLineNbr

End Function

Function VerifyVendor() As Boolean
Dim dbItem As DAO.Database, rsItem As DAO.Recordset
Dim sSQL As String, sVendor As String

On Error GoTo err_VerifyVendor

VerifyVendor = False
Set dbItem = CurrentDb()
sSQL = "SELECT * FROM tblItemFile WHERE PartNum='" & Me.PartNum & "';"
Set rsItem = dbItem.OpenRecordset(sSQL, dbOpenDynaset)
If ((Not (rsItem.BOF And rsItem.EOF)) And (rsItem.RecordCount > 0)) Then
rsItem.MoveLast
rsItem.MoveFirst
sVendor = Forms!frmMaintainPO.VendorID
If (sVendor = rsItem.Fields("VendorID")) Then
VerifyVendor = True
End If
End If

exit_VerifyVendor:
rsItem.Close
dbItem.Close
Set rsItem = Nothing
Set dbItem = Nothing
Exit Function

err_VerifyVendor:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In VerifyVendor", vbExclamation + vbOKOnly, Me.Name
Resume exit_VerifyVendor

End Function

Function GetPart() As Boolean
Dim dbItem As DAO.Database, rsItem As DAO.Recordset
Dim sSQL As String

On Error GoTo err_GetPart

Set dbItem = CurrentDb()
sSQL = "SELECT * FROM tblItemFile WHERE PartNum='" _
& Me.PartNum & "';"
Set rsItem = dbItem.OpenRecordset(sSQL, dbOpenDynaset)
If (Not (rsItem.BOF And rsItem.EOF)) Then
Me.Description = rsItem.Fields("Description")
Me.Cost = rsItem.Fields("Cost")
Me.Taxable = rsItem.Fields("Taxable")
GetPart = True
Else
GetPart = False
End If

exit_GetPart:
rsItem.Close
dbItem.Close
Set rsItem = Nothing
Set dbItem = Nothing
Exit Function

err_GetPart:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In GetPart", vbExclamation + vbOKOnly, Me.Name
Resume exit_GetPart

End Function

Private Sub Qty_AfterUpdate()
Dim vResult As Variant

On Error GoTo err_Qty_AfterUpdate

If (Me.Qty > 0 And Me.Cost > 0) Then
Me.Extended = (Me.Qty * Me.Cost)
Else
Me.Extended = 0
End If

If (IsNull(Me.Qty) Or IsNull(Me.Cost)) Then
Me.Extended = 0
End If

If ((Me.Extended.OldValue <> Me.Extended.Value) Or
(IsNull(Me.Extended.OldValue))) Then
If (CalcTax = False) Then
MsgBox "Error calculating the tax. Please verify your entry", _
vbExclamation + vbOKOnly, "Tax Error"
End If
End If

exit_Qty_AfterUpdate:
Exit Sub

err_Qty_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Qty_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Qty_AfterUpdate

End Sub

Private Sub Taxable_AfterUpdate()
Dim vResult As Variant

If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If

On Error GoTo err_Taxable_AfterUpdate

exit_Taxable_AfterUpdate:
Exit Sub

err_Taxable_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Taxable_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Taxable_AfterUpdate

End Sub

Private Function UpdateMiscFields() As Boolean

' If (Me.NewRecord) Then
' Me!Received = False
' Else
Application.Forms(Me.Parent.Name).UpdatePOFooter
If (Err.Number <> 0) Then
UpdateMiscFields = True
Else
UpdateMiscFields = False
End If
' End If
End Function
What version of Access? The SubForm's AfterUpdate event should fire when the
SubForm is Dirty and you move the focus back to the MainForm.
[quoted text clipped - 7 lines]
 
R

ruralguy via AccessMonster.com

Just ask Google about Free File Hosting.
Sure, where would I do that? Do you have the URL?
Pat,
Any chance you can upload your db to one of the free file hosting sites?
[quoted text clipped - 295 lines]
 
P

Pat

I placed it at <a
href='http://www.mediafire.com/?aqaaawasuaq'>http://www.mediafire.com/?aqaaawasuaq</a>

Launch the from frmMaintainPO. You can use an existing PO for the entries.
The problem occurs on any lines entered.

ruralguy via AccessMonster.com said:
Just ask Google about Free File Hosting.
Sure, where would I do that? Do you have the URL?
Pat,
Any chance you can upload your db to one of the free file hosting sites?
[quoted text clipped - 295 lines]
GetPart = True
Else
 

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

Top