Solved checkbox placed in frame by a query, not responding (1 Viewer)

Ashisht76

Member
Local time
Tomorrow, 01:01
Joined
Jan 31, 2022
Messages
44
Hi Everyone,

First of all Im highly obliged to read my problem and thankful to try to help me to solve.

In access I have table "TblOrder","TblGreyFabricOrder" and "SubTblGreyGabricOrder", "TblGreyFabricOrder" has form "FrmGreyFabricOrder" which also has frame ( SubForm /SubReport) "FraQryTblOrder" which has source Object has a query"QryTblOrder".

"QryTblOrder" displays filtered data of "TblOrder" based on textbox ("PurchaseQuality") and it has a checkbox "GreyCBPO". Upon selecting this check box and pressing button "BtnCreateGreyPO" on form runs below code that updates "TblOrder" and "SubTblGreyGabricOrder".

"GreyCBPO" works most of the time but sometimes it stops responding and the only solution i found is to redesign entire form again for it to work.Does any one can tell me how it can be avoided. Once again I am very thankful for your time and efforts.

Below is code

Private Sub BtnCreateGreyPO_Click() 'FrmGreyFabricOrder019

On Error GoTo Error_Handler
EntFrm = False

Dim db As DAO.Database

Dim strSQL As String
strSQL = "SELECT * FROM TblOrder WHERE GreyCBPO= True AND TblOrder.OrderQuality = " & [Forms]![FrmGreyFabricOrder]![PurchaseQuality]
Dim rst As DAO.Recordset

Dim strSQL1 As String
strSQL1 = "SubTblGreyFabricOrder"
Dim rst1 As DAO.Recordset

Dim EntGyQy As Single, SelGyQty As Single, UpGQty As Single, BalEntQty As Single, InPu As Single, x As Long, BalGyQty As Single

SelGyQty = Me.TxtTtlGyQtySelected
EntGyQy = Me.TotalGreyPurchaseQuantity.Value
BalGyQty = 0
UpGQty = 0
BalEntQty = EntGyQy - UpGQty
x = 1 ' Record Counter

Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
Set rst1 = db.OpenRecordset(strSQL1, dbOpenDynaset)

If rst1.BOF And rst1.EOF Then
'MsgBox "NO record found."
'Exit Sub
End If

If rst.BOF And rst.EOF Then
Exit Sub
End If
'******************* 'If this is first record then fill in straight
If EntGyQy = SelGyQty Then
rst.MoveFirst
Do Until rst.EOF
UpGQty = rst!GreyQuantity
rst.Edit
rst("GreyPOQuantity").Value = UpGQty
rst.Update


'rst1.MoveLast
rst1.AddNew
rst1("TblGreyFabricOrderID_FK").Value = Me.GreyOrderID
rst1("OrderID_FK").Value = rst("OrderID").Value
rst1("GreyPOQuantity").Value = UpGQty
rst1("PurchaesRate").Value = Me.PurchaesRate
rst1.Update
'Debug.Print rst1.RecordCount
rst.MoveNext
Loop
GoTo HandleExit
End If
'*******************
'Debug.Print rst.RecordCount
rst.MoveFirst
Do Until rst.EOF
BalGyQty = BalGyQty + rst("GreyQuantity")
rst.MoveNext
Loop
'Debug.Print BalGyQty

'_+_+_+_+_+_+_+_+_
If EntGyQy < SelGyQty Then
rst.MoveFirst
If rst.recordCount = x Then ' determines if this is last record
UpGQty = BalEntQty
rst.Edit
rst("GreyPOQuantity").Value = UpGQty
rst.Update


rst1.AddNew
rst1("TblGreyFabricOrderID_FK").Value = Me.GreyOrderID
rst1("OrderID_FK").Value = rst("OrderID").Value
rst1("GreyPOQuantity").Value = UpGQty
rst1("PurchaesRate").Value = Me.PurchaesRate
rst1.Update
'Debug.Print rst1.recordCount
GoTo HandleExit
End If


Do Until rst.EOF

If BalEntQty <= 0 Then 'Determines if there is no (entered) quantity left to allocate
MsgBox "All allocation done."
GoTo HandleExit
End If


If MsgBox("For Order : " & rst!OrderNum & " Do you want to raise Grey PO for full require quatity?", vbYesNo + vbQuestion) = vbYes Then ' if user want to enter full quantity then there is no problem
'-*-*-*-*-*- 'If the BalEntQty is less than GryQty then Po qty can not be used but balance of EntQty will be updaeted
If BalEntQty > rst!GreyBalanceToOrder Then
UpGQty = rst!GreyBalanceToOrder
Else
UpGQty = BalEntQty
End If
'-*-*-*-*-*-

rst.Edit
rst("GreyPOQuantity").Value = UpGQty
'Debug.Print UpGQty
rst.Update


rst1.AddNew
rst1("TblGreyFabricOrderID_FK").Value = Me.GreyOrderID
rst1("OrderID_FK").Value = rst("OrderID").Value
rst1("GreyPOQuantity").Value = UpGQty
rst1("PurchaesRate").Value = Me.PurchaesRate
rst1.Update
Debug.Print rst1.recordCount

BalEntQty = BalEntQty - UpGQty 'deducting assigned value from Total of entered quantity by user
BalGyQty = BalGyQty - rst!GreyQuantity
'BalSecQty = BalSecQty - UpGQty

Else

InputLine:

InPu = InputBox("Please enter quantity you want, it must be less then " & Round(rst!GreyBalanceToOrder), 0, 1) ' Asking user to give input
'Input Qty ,must be less then GreyPOQty and BalEntQty

'--------
If Not IsNumeric(InPu) Then
MsgBox "Please enter Number only!"
GoTo InputLine
End If


If InPu = BalEntQty And rst("GreyBalanceToOrder").Value >= InPu Then ' this means user want to enter all balance quantity in this order and exit.
rst.Edit
rst("GreyPoQuantity").Value = InPu ' filling up empty record with balance quantity
rst.Update
GoTo HandleExit
End If

If InPu > rst!GreyBalanceToOrder.Value Then 'Input value can not exceed Grey requierment for that record
MsgBox "Invaid Value, Please enter equal or less then" & rst!GreyBalanceToOrder.Value
GoTo InputLine
End If

If InPu > BalEntQty Then 'Input value can not exceed Grey Balance quantity
MsgBox "Invaid Value, Please enter equal or less then" & BalEntQty
GoTo InputLine
End If

If rst.recordCount = x Then ' If this is last record then entire balance quantity must be entered to this order
If InPu < BalEntQty Then
MsgBox "Invaid Value, Please enter equal to " & BalEntQty
GoTo InputLine
End If
End If

' from here on you have to move down the record till last record and sum up Grey Quantity
' and compare it with bal ent qty - InPu
BalGyQty = BalGyQty - rst!GreyQuantity ' Finding out BalGyqty after hypothetically this quantity does thru
If BalGyQty < BalEntQty - InPu Then 'Above qty is compared with Remaining of enter Qty
MsgBox "Insufficient Value, Please enter higher value to complete entered quantity."
'this means, in case this InPu qty is allowed to enter this records, there will be EntQty reamins with NO GreyQty
BalGyQty = BalGyQty + rst!GreyQuantity
GoTo InputLine
Else
BalGyQty = BalGyQty + rst!GreyQuantity
End If

'--------

rst.Edit
rst("GreyPOQuantity").Value = InPu ' filling up empty record with balance quantity
rst.Update

Debug.Print Me.GreyOrderID
rst1.AddNew
rst1("TblGreyFabricOrderID_FK").Value = Me.GreyOrderID
rst1("OrderID_FK").Value = rst("OrderID").Value
rst1("GreyPOQuantity").Value = UpGQty
rst1("PurchaesRate").Value = Me.PurchaesRate
rst1.Update
Debug.Print rst1.recordCount

UpGQty = InPu
BalEntQty = BalEntQty - UpGQty 'deducting assigned value from Total of entered quantity by user
BalGyQty = BalGyQty - rst!GreyQuantity
'BalSecQty = BalSecQty - UpGQty
End If


x = x + 1
rst.MoveNext
Loop
End If
'_+_+_+_+_+_+_+_+_+
Call UpdtSumOfTotalAmount

HandleExit:
rst.Close
Set rst = Nothing
rst1.Close
Set rst1 = Nothing
Set db = Nothing
TxtTtlGyQtySelected = Null


DoCmd.Hourglass True
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE TblOrder SET TblOrder.GreyCBPO = False "
Me.Dirty = False ' suggested by ChetGPT
DoCmd.Hourglass False
DoCmd.SetWarnings True
Me.AllowEdits = False

Error_Handler:
Select Case Err.Number
Case 2501 '' save was not completed
MsgBox "Error saving record: The command or action 'SaveRecord' isn't available now."
Resume HandleExit
Case 3201 '' save was not completed
MsgBox "Error saving record: The command or action 'SaveRecord' isn't available now."
Resume HandleExit
Case 63
MsgBox "Error saving record: Bad record number. Please check the validity of record numbers."
Resume HandleExit
Case 13
MsgBox "Error saving record: Invalid value."
Resume HandleExit
Case Else
'MsgBox "The record cannot be saved!"
End Select

End Sub
 

Attachments

  • Screenshot_1.png
    Screenshot_1.png
    51.2 KB · Views: 85
Last edited:
TblGreyFabricOrder
This strikes me as very strange. Why not have tblOrder, with tblOrderLineItems, and each lineitem has a ProductID coming from tblProduct, and one of those products is GreyFabric?
Example: Northwind 2.0 Access templates.
 
Add Option Explicit to the top of the module. Compile and fix all the compile errors. You will need to Dim your variables.
Then indent the code properly so it is readable and post it using the code tool.
When referring to form controls, use Me.ControlName control names are easy to identify plus you get intellisense.

PS, I agree with Tom that the schema may need clarifying.
Last step
Then set the property to require all variable declarations to true and then open, every single module in the application and add option explicit to it also. Just setting the property does not fix old, existing modules. Then compile the application and define all the variables and fix all the compile errors.
 

Users who are viewing this thread

Back
Top Bottom