Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Form will not process more than 564 records 3

Status
Not open for further replies.

bustersports

Programmer
Sep 25, 2002
92
US
Thanks for reading and any suggestions you may have.

I have a form that will have anywhere from few hundred records, up to about 20,000. For some reason, it will not step through more than 564 records. In troubleshooting, I even put the max records to 500, close the form, and start again. It will then still max out at a total of 564 between opening the form twice. I have another very similar form, that will process all records with no problems. Below is my code for the NON-working form, below it is the correctly working form. Any suggestions as what may be causing the problem?


NON-Working Form

Private Sub cmdCalculatePayment_Click()

Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim RecordCount As Boolean

DoCmd.GoToRecord , "", acFirst
Z = txtRecordsFound + 1
Y = Z - 1
For X = 1 To Y

If [Forms]![frmSelectChargeAccessorials].txtTotalRatesFoundAccessorial = 0 Then

Call NROF

Else

If txtCostBasis = "CostBasis" Then
Call CostBasis

Else

If txtCostBasis = "CPP" Then
Call WeightTimesRate

Else
If txtCostBasis = "CPK" Then
Call WeightTimesRate

Else

If txtCostBasis = "WeightTimesRate" Then
Call WeightTimesRate

Else

If txtCostBasis = "CWT" Then
Call CWT

Else

If txtCostBasis = "FlatCharge" Then
Call FlatCharge

Else

If txtCostBasis = "Container" Then
Call PerUnit

Else

If txtCostBasis = "HAWB" Then
Call PerUnit

Else
If txtCostBasis = "Per Container Per Day" Then
Call PerUnit

Else

If txtCostBasis = "PerDay" Then
Call PerUnit

Else

If txtCostBasis = "PerHour" Then
Call PerUnit

Else

If txtCostBasis = "Per KG Per Day" Then
Call PerUnit

Else
If txtCostBasis = "PerMonth" Then
Call PerUnit

Else

If txtCostBasis = "Per Mile" Then
Call PerUnit

Else

If txtCostBasis = "Per Shipment" Then
Call PerUnit

Else

If txtCostBasis = "Per Trip" Then
Call PerUnit

Else

If txtCostBasis = "PerUnit" Then
Call PerUnit

Else

If txtCostBasis = "Cost Per Cubic Meter" Then
Call PassThrough

Else
If txtCostBasis = "PassThrough" Then
Call PassThrough

Else

If txtCostBasis = "Percent" Then
Call PassThrough

Else

End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

DoCmd.Hourglass True

DoCmd.GoToRecord , "", acNext

txtRecordsFound.Requery

Next X

DoCmd.Hourglass False

Requery

End Sub


Correctly Working


Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim TariffNumber As Integer

[Forms]![frmSelectChargeFreight]![subfrmSelectChargeFreight4].Requery
TariffNumber = [Forms]![frmSelectChargeFreight].txtTariffNumber

DoCmd.GoToRecord , "", acFirst
Z = txtRecordsFound + 1
Y = Z - 1
For X = 1 To Y

[Forms]![frmSelectChargeFreight]![subfrmSelectChargeFreight5].Requery

[Forms]![frmSelectChargeFreight]![subfrmSelectChargeFreight4].Requery

[Forms]![frmSelectChargeFreight]![subfrmSelectChargeFreight5].Requery 'txtRatesFound

'txtRatesFound.Requery

If txtRatesFound = 0 Then

txtPostAuditComments = "NROF"
txtPostAuditRefund = Paid
optComplete = -1
optPostAuditClaim = -1
txtAdjCorrectAmt = 0
optComplete.SetFocus
cboReason = 5

Else

If TariffNumber = 1 Then 'Rate is cost basis

Call CostBasis

Else

If TariffNumber = 2 Then 'CPP or CPK, weight times rate

Call WeightTimesRate

Else

If TariffNumber = 3 Then 'Rate is CWT

Call CWT

Else

If TariffNumber = 4 Then 'Flat charge

Call FlatCharge

Else

If TariffNumber = 5 Then 'Per Unit (Per Hour, Per Month, Per Month, etc)

Call PerUnit

Else

If TariffNumber = 6 Then 'Pass Through or Percent or Cubic Meter

Call PerUnit

Else

End If
End If
End If
End If
End If
End If
End If

DoCmd.SetWarnings True

'txtRatesFound.Requery
txtNumberRatesFound = txtRatesFound

DoCmd.GoToRecord , "", acNext

'txtRecordsFound.Requery

Next X

DoCmd.Hourglass False

End Sub
 
If I did not goof anything up, here is your somewhat cleaned-up SQL for your query - using Aliases as recommended..
Code:
SELECT trc.RateIDNumber, trc.LoadIDNumber, trc.Carrier, trc.[Amendment#], trc.EffectiveDate, trc.ExpirationDate, cqt.SCAC, trc.Mode, trc.OriginPort, trc.OriginCountry, trc.OriginGeo, trc.DestinationPort, trc.DestinationCountry, trc.DestinationGeo, trc.MinWeight, trc.MaxWeight, trc.WeightType, trc.DimFactor, trc.ServiceCode, trc.ServiceLevelCode, trc.DeliveryTime, trc.EquipType, trc.DeliveryTime, trc.ServiceType, trc.SupplierCode, trc.IntelCode, trc.TariffName, trc.Rate, trc.MinCharge, trc.MaxCharge, trc.ZoneFlag, trc.TPT, trc.Comment, trc.LastUpdate, trc.CTSIID, trc.AccessorialType, trc.AccessorialCode, trc.Volume, trc.IntelDesc, trc.Archive, trc.RateTable, trc.Accessorial, trc.TariffCodeNumber, Count(trc.ServiceLevelCode) AS CountOfServiceLevelCode
FROM tblCarrierQtrlyTool AS cqt INNER JOIN tblRatesCombined AS trc ON cqt.RateTableSCAC = trc.Carrier
GROUP BY trc.RateIDNumber, trc.LoadIDNumber, trc.Carrier, trc.[Amendment#], trc.EffectiveDate, trc.ExpirationDate, cqt.SCAC, trc.Mode, trc.OriginPort, trc.OriginCountry, trc.OriginGeo, trc.DestinationPort, trc.DestinationCountry, trc.DestinationGeo, trc.MinWeight, trc.MaxWeight, trc.WeightType, trc.DimFactor, trc.ServiceCode, trc.ServiceLevelCode, trc.EquipType, trc.DeliveryTime, trc.ServiceType, trc.SupplierCode, trc.IntelCode, trc.TariffName, trc.Rate, trc.MinCharge, trc.MaxCharge, trc.ZoneFlag, trc.TPT, trc.Comment, trc.LastUpdate, trc.CTSIID, trc.AccessorialType, trc.AccessorialCode, trc.Volume, trc.IntelDesc, trc.Archive, trc.RateTable, trc.Accessorial, trc.TariffCodeNumber, trc.DeliveryTime
HAVING (((trc.EffectiveDate)<=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtShipDate]) AND ((trc.ExpirationDate)>=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtShipDate]) AND ((cqt.SCAC)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtSCAC]) AND ((trc.OriginPort)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtOrigPort] Or (trc.OriginPort)="ZZZ") AND ((trc.OriginCountry)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtOrigCntryTwoChar] Or (trc.OriginCountry)="ZZZ") AND ((trc.OriginGeo)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtOrigGeo] Or (trc.OriginGeo)="ZZZ" Or (trc.OriginGeo)="ZZ") AND ((trc.DestinationPort)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtDestPort] Or (trc.DestinationPort)="ZZZ") AND ((trc.DestinationCountry)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtDestCntryTwoChar] Or (trc.DestinationCountry)="ZZZ") AND ((trc.DestinationGeo)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtDestGeo] Or (trc.DestinationGeo)="ZZZ" Or (trc.DestinationGeo)="ZZ") AND ((trc.ServiceCode)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtServiceTypeCode] Or (trc.ServiceCode)="N/A" Or (trc.ServiceCode) Is Null) AND ((trc.ServiceLevelCode)=[Forms]![frmSelectChargeAccessorials]![txtServiceLevelCode] Or (trc.ServiceLevelCode)="N/A" Or (trc.ServiceLevelCode) Is Null) AND ((trc.EquipType)=[Forms]![frmSelectChargeAccessorials]![txtEquipmentType] Or (trc.EquipType)="N/A" Or (trc.EquipType) Is Null) AND ((trc.AccessorialCode)=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtFeeCode]) AND (((trc.DeliveryTime)=[Forms]![frmSelectChargeAccessorials]![txtServiceTime] Or (trc.DeliveryTime)="N/A" Or (trc.DeliveryTime) Is Null) And ((trc.DeliveryTime)=[Forms]![frmSelectChargeAccessorials]![txtServiceTime] Or (trc.DeliveryTime)="N/A" Or (trc.DeliveryTime) Is Null)));

Didn't help much b/c there's just SO MUCH there, but at least it's maybe a start at being able to read the crazy thing.

I wonder if perhaps no other way is possible, this could be broken into a few smaller queries that reference one another?

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Here's a thought on the query, assuming there may be issues there...

I'm wondering if some of the items in the HAVING clause should be instead in a WHERE clause. Such as the first couple:

HAVING (((trc.EffectiveDate)<=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtShipDate])

AND ((trc.ExpirationDate)>=[Forms]![frmSelectChargeAccessorials]![subfrmSelectChargeAccessorials2].[Form]![txtShipDate]


It may not be the case, but it's my first thought.

By the way, not certain why the query text above posted the way it did. At least the TGML now seems to handle lines that run on and on by allowing you to scroll instead of making the web page go crazy. [smile]


"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
calls all make a call to a different rate calculation
So for each record on your form you get the rate calculation based on the value of the field (whatever field is the control source for txtcostbasis). But what do you do with that rate? You do not return it to the call procedure. Do you update the record based on that value? Could you show the code for WeightTimesRate
 
Here is the WeightTimesRate code, I know it is not in the format suggested earlier, I do have TGML clicked.

Private Sub WeightTimesRate()

[Forms]![frmSelectChargeAccessorials].txtExpected = [Forms]![frmSelectChargeAccessorials].txtRate * [Forms]![frmSelectChargeAccessorials].txtWeight

If [Forms]![frmSelectChargeAccessorials].txtBalance < 0.01 Then
txtPostAuditRefund = Null
optPostAuditClaim = 0
txtPostAuditComments = "No claim, correct charge."
optComplete = -1
cboReason = 161
txtAdjCorrectAmt = [Forms]![frmSelectChargeAccessorials].txtExpected

Else

txtPostAuditRefund = [Forms]![frmSelectChargeAccessorials].txtBalance
optPostAuditClaim = -1
txtPostAuditComments = "Overpayment"
optComplete = -1
cboReason = 3
txtAdjCorrectAmt = [Forms]![frmSelectChargeAccessorials].txtExpected

End If

'Correct payment

If txtPostAuditRefund = 0 Then
txtPostAuditComments = "Correct payment"
optComplete = -1
txtPostAuditComments.SetFocus
txtPostAuditRefund = Null

Else

'Under payment

If txtPostAuditRefund < 0 Then
txtPostAuditRefund = Null
optComplete = -1
txtPostAuditComments = "Underpayment"
cboReason = 7

Else

'Over payment

If [Forms]![frmSelectChargeAccessorials].txtRatesFound = 0 Then

txtPostAuditComments = "NROF"
optComplete = -1
cboReason = 3
optPostAuditClaim = -1
txtAdjCorrectAmt = Paid - txtPostAuditRefund

Else

If PostAuditRefund > 0 Then
txtPostAuditComments = "Overpayment"
optComplete = -1
cboReason = 3
optPostAuditClaim = -1
txtAdjCorrectAmt = Paid - txtPostAuditRefund

End If
End If

If txtPostAuditRefund > 5 Then
optPostAuditClaim = -1

Else

If [Forms]![frmSelectChargeAccessorials].txtExpected < [Forms]![frmSelectChargeAccessorials].txtMinCharge Then
[Forms]![frmSelectChargeAccessorials].txtExpected = [Forms]![frmSelectChargeAccessorials].txtMinCharge

Call MinimumCharge

Else

If [Forms]![frmSelectChargeAccessorials].txtExpected > [Forms]![frmSelectChargeAccessorials].txtMaxCharge Then
[Forms]![frmSelectChargeAccessorials].txtExpected = [Forms]![frmSelectChargeAccessorials].txtMaxCharge

Call MaximumCharge

Else

End If
End If
End If
End If
End If

txtNumberRatesFound = [Forms]![frmSelectChargeAccessorials].txtTotalRatesFoundAccessorial

End Sub

Below is the MinimumCharge called, Max and Min are the same formats

Private Sub MinimumCharge()

Dim RefundDue As Integer

If [Forms]![frmSelectChargeAccessorials].txtExpected > txtPaid Then
txtPostAuditRefund = Null
optPostAuditClaim = 0
txtPostAuditComments = "No claim, under payment."
optComplete = -1
cboReason = 161
txtAdjCorrectAmt = [Forms]![frmSelectChargeAccessorials].txtExpected

Else

txtPostAuditRefund = [Forms]![frmSelectChargeAccessorials].txtBalance
optPostAuditClaim = -1
txtPostAuditComments = "Overpayment"
optComplete = -1
cboReason = 3
txtAdjCorrectAmt = [Forms]![frmSelectChargeAccessorials].txtMinCharge

End If

txtNumberRatesFound = [Forms]![frmSelectChargeAccessorials].txtTotalRatesFoundAccessorial

End Sub
 
Just one other piece of information, in case it helps. After I hit the 564 records, and close the form, if I try to open anything else, get the message Cannot Open Any More Tables. I have to close Access and re-open it.
 
You may be able to fix what you have, but this is pretty Rude Goldbergish that no one else could. I am guessing that this could be done orders of magnitude simpler, but at this point need to weigh what that would take.

The normal approach would be to do this is a series of sql update queries. You could do so much heavy lifting with sql. For example you run through each record and determine the cost basis, then you do some action based on that cost basis. A much simpler way would be to process all the records with the same cost basis.

If using a recordset something like

Code:
dim rs as dao.recordset
dim strSql as string
strSql = "select * from some table where costbasis in ('CPP', 'CPK', 'WeightTimesRate')"
set rs = currentdb.openrecordset(strSql)
Now process all the records with that cost basis.

Or even easier you save a query
qryWeightTimesRate
then you code is simply
Code:
dim rs as dao.recordset
set rs = currentdb.openrecordset(qryWeightTimesRate)

You definitely get a gold star for brute force effort, but this would be really really hard to maintain.
 
You often refer to [Forms]![frmSelectChargeAccessorials], so for a start to make your code readable, you may try:

Code:
Private Sub WeightTimesRate()
[blue]
With [Forms]![frmSelectChargeAccessorials]
    .txtExpected = .txtRate * .txtWeight[/blue]

    If [blue].txtBalance [/blue]< 0.01 Then
        txtPostAuditRefund = Null
        optPostAuditClaim = 0
        txtPostAuditComments = "No claim, correct charge."
        optComplete = -1
        cboReason = 161
        txtAdjCorrectAmt = [blue].txtExpected
[/blue]
    Else
        ....[blue]
End With[/blue]

" I do have TGML clicked" well, how come it works for everybody elase here but you...? :-(

Try:[red][ignore]
Code:
Your code here
[/ignore]
[/red]
and use Preview to see your post before you post.

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.
 
Thank you very much to all of your responses. I greatly appreciate the help you have provided and especially the coaching in doing better coding.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top