Z
Zaz
I'm going to make this as detailed as possible in an attempt to provide all
information needed outright. I have (in my opinion) a fairly complex issue
going on where I can't update my database under certain circumstances.
The tables involved are LOT and SUBLOT and the specific records involved are
OriginalQty, QtyOnHand, and QtyDispersed. I've written my code to try and
avoid another situation where the save dialogue was at times popping up twice
when altering the QtyDispersed field of my form.
As of now, when altering the QtyDispersed field I'm getting an error at the
Me.Refresh line of the TxtQtyDispersed_BeforeUpdate sub. I had also tried to
set Me.TxtQtyDispersed to a value in this same section and it would not allow
me to do that as well. Please let me know what I have to do to fix this or
what alternative ways I might accomplish the task at hand. All of the
relevant code for the form follows....
Public flag As Boolean
Private Sub Form_BeforeUpdate(Cancel As Integer)
If (IsNull(Me.txtLotNumber) = True) Then
MsgBox "Please complete all required fields", vbOKOnly, "Incomplete
Form"
Cancel = True
Else
If (IsNull(Me.TxtSublot) = True) Then
MsgBox "Please complete all required fields", vbOKOnly,
"Incomplete Form"
Cancel = True
Else
If (IsNull(Me.TxtQtyDispersed) = True) Then
MsgBox "Please complete all required fields", vbOKOnly,
"Incomplete Form"
Cancel = True
End If
End If
End If
If flag = True Then
[TxtInitials] = CurrentUser()
[TxtLastUpdated] = Now()
On Error GoTo ErrHandler
Dim answer As Integer
If (Me.Dirty) Then
answer = MsgBox("The record has been modified, do you wish to
save changes?" & vbCrLf & vbCrLf & _
"'No' will clear the form and 'Cancel' will leave it as
is...", vbYesNoCancel, "Save Changes?")
If (answer = vbNo) Then
Me.Undo
End If
If (answer = vbCancel) Then
Cancel = True
End If
End If
End If
Exit Sub
Me.txtLotNumber.SetFocus
ErrHandler:
MsgBox "Error in Form_BeforeUpdate( ) in" & vbCrLf & Me.Name & _
" form." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & Err.Description
Err.Clear
End Sub
Private Sub Form_Current()
If Me.TxtQtyDispersed <> Null Or Me.TxtQtyDispersed <> "" Then
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
End If
flag = False
End Sub
Private Sub Form_Dirty(Cancel As Integer)
flag = True
End Sub
Private Sub Form_Load()
DoCmd.GoToRecord , , acNewRec
Me.txtLotNumber.SetFocus
flag = False
End Sub
Private Sub TxtClinicalResults_Change()
flag = True
End Sub
Private Sub txtLotNumber_GotFocus()
If Me.txtLotNumber <> "" Then
Me.txtLotNumber.Locked = True
Else
Me.txtLotNumber.Locked = False
End If
End Sub
Private Sub TxtQtyDispersed_BeforeUpdate(Cancel As Integer)
If Me.TxtQtyDispersed < 0 Then
Me.CalcBox = Me.TxtQtyDispersed
MsgBox "A negative number can't be entered in this field!" + vbLf +
vbLf + " Please make appropriate adjustments.", vbOKOnly, "Inventory Error"
DoCmd.CancelEvent
End If
Me.CalcBox = Me.TxtQtyDispersed
If Me.Dirty Then
flag = False
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
If Me.TxtQtyOnHand < 0 Then
MsgBox "There is not enough material remaining to remove this
amount!" + vbLf + vbLf + " Please make appropriate adjustments.", vbOKOnly,
"Inventory Error"
DoCmd.CancelEvent
Me.TxtQtyDispersed = Me.CalcBox
Me.Refresh
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
End If
flag = True
End If
End Sub
Private Sub TxtQtyDispersed_LostFocus()
If Me.Dirty Then
Me.Refresh
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
flag = False
End If
End Sub
Private Sub txtStorage_Change()
flag = True
End Sub
Private Sub txtSublot_BeforeUpdate(Cancel As Integer)
Dim lotLength As Single
lotLength = Len(txtLotNumber)
If Left(Me.[TxtSublot], lotLength) <> Me.[txtLotNumber] Then
MsgBox "This sublot number does not match the lot!" + vbLf + vbLf +
" Please enter a different number.", vbOKOnly, "Incorrect Entry"
DoCmd.CancelEvent
End If
If DCount("[API_SUBLOT]![Sublot]", "[API_SUBLOT]",
"[API_SUBLOT]![Sublot] = '" & [Sublot] & "'") <> 0 Then
MsgBox "This sublot number has already been entered!" + vbLf + vbLf
+ " Please enter a different number.", vbOKOnly, "Duplicate Entry"
DoCmd.CancelEvent
End If
End Sub
Private Sub txtSublot_Change()
flag = True
End Sub
information needed outright. I have (in my opinion) a fairly complex issue
going on where I can't update my database under certain circumstances.
The tables involved are LOT and SUBLOT and the specific records involved are
OriginalQty, QtyOnHand, and QtyDispersed. I've written my code to try and
avoid another situation where the save dialogue was at times popping up twice
when altering the QtyDispersed field of my form.
As of now, when altering the QtyDispersed field I'm getting an error at the
Me.Refresh line of the TxtQtyDispersed_BeforeUpdate sub. I had also tried to
set Me.TxtQtyDispersed to a value in this same section and it would not allow
me to do that as well. Please let me know what I have to do to fix this or
what alternative ways I might accomplish the task at hand. All of the
relevant code for the form follows....
Public flag As Boolean
Private Sub Form_BeforeUpdate(Cancel As Integer)
If (IsNull(Me.txtLotNumber) = True) Then
MsgBox "Please complete all required fields", vbOKOnly, "Incomplete
Form"
Cancel = True
Else
If (IsNull(Me.TxtSublot) = True) Then
MsgBox "Please complete all required fields", vbOKOnly,
"Incomplete Form"
Cancel = True
Else
If (IsNull(Me.TxtQtyDispersed) = True) Then
MsgBox "Please complete all required fields", vbOKOnly,
"Incomplete Form"
Cancel = True
End If
End If
End If
If flag = True Then
[TxtInitials] = CurrentUser()
[TxtLastUpdated] = Now()
On Error GoTo ErrHandler
Dim answer As Integer
If (Me.Dirty) Then
answer = MsgBox("The record has been modified, do you wish to
save changes?" & vbCrLf & vbCrLf & _
"'No' will clear the form and 'Cancel' will leave it as
is...", vbYesNoCancel, "Save Changes?")
If (answer = vbNo) Then
Me.Undo
End If
If (answer = vbCancel) Then
Cancel = True
End If
End If
End If
Exit Sub
Me.txtLotNumber.SetFocus
ErrHandler:
MsgBox "Error in Form_BeforeUpdate( ) in" & vbCrLf & Me.Name & _
" form." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & Err.Description
Err.Clear
End Sub
Private Sub Form_Current()
If Me.TxtQtyDispersed <> Null Or Me.TxtQtyDispersed <> "" Then
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
End If
flag = False
End Sub
Private Sub Form_Dirty(Cancel As Integer)
flag = True
End Sub
Private Sub Form_Load()
DoCmd.GoToRecord , , acNewRec
Me.txtLotNumber.SetFocus
flag = False
End Sub
Private Sub TxtClinicalResults_Change()
flag = True
End Sub
Private Sub txtLotNumber_GotFocus()
If Me.txtLotNumber <> "" Then
Me.txtLotNumber.Locked = True
Else
Me.txtLotNumber.Locked = False
End If
End Sub
Private Sub TxtQtyDispersed_BeforeUpdate(Cancel As Integer)
If Me.TxtQtyDispersed < 0 Then
Me.CalcBox = Me.TxtQtyDispersed
MsgBox "A negative number can't be entered in this field!" + vbLf +
vbLf + " Please make appropriate adjustments.", vbOKOnly, "Inventory Error"
DoCmd.CancelEvent
End If
Me.CalcBox = Me.TxtQtyDispersed
If Me.Dirty Then
flag = False
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
If Me.TxtQtyOnHand < 0 Then
MsgBox "There is not enough material remaining to remove this
amount!" + vbLf + vbLf + " Please make appropriate adjustments.", vbOKOnly,
"Inventory Error"
DoCmd.CancelEvent
Me.TxtQtyDispersed = Me.CalcBox
Me.Refresh
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
End If
flag = True
End If
End Sub
Private Sub TxtQtyDispersed_LostFocus()
If Me.Dirty Then
Me.Refresh
Me.TxtQtyOnHand = TxtOriginalQty - DSum("[QtyDispersed]",
"API_SUBLOT", "[TxtLotNumber]=[LotNumber]")
flag = False
End If
End Sub
Private Sub txtStorage_Change()
flag = True
End Sub
Private Sub txtSublot_BeforeUpdate(Cancel As Integer)
Dim lotLength As Single
lotLength = Len(txtLotNumber)
If Left(Me.[TxtSublot], lotLength) <> Me.[txtLotNumber] Then
MsgBox "This sublot number does not match the lot!" + vbLf + vbLf +
" Please enter a different number.", vbOKOnly, "Incorrect Entry"
DoCmd.CancelEvent
End If
If DCount("[API_SUBLOT]![Sublot]", "[API_SUBLOT]",
"[API_SUBLOT]![Sublot] = '" & [Sublot] & "'") <> 0 Then
MsgBox "This sublot number has already been entered!" + vbLf + vbLf
+ " Please enter a different number.", vbOKOnly, "Duplicate Entry"
DoCmd.CancelEvent
End If
End Sub
Private Sub txtSublot_Change()
flag = True
End Sub