Form Subtotals, Help with slow code... 1

[sunmorgus]

Hello, I have a question regarding some subtotal code I have on a form. This code calculates a subtotal for the status of each product returned for repair (taken from a backlog query, which show all products in house, and their status). The code is as follows:

Me.WarWIP.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='WIP' and [Warranty Status]='Under Warranty'")
Me.WarAWM.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='AWM' and [Warranty Status]='Under Warranty'")
Me.WarAWA.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='AWA' and [Warranty Status]='Under Warranty'")
Me.WarPPW.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='PPW' and [Warranty Status]='Under Warranty'")
Me.WarNAF.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='NAF' and [Warranty Status]='Under Warranty'")
Me.NonWIP.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='WIP' and [Warranty Status]='Out Of Warranty'")
Me.NonAWM.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='AWM' and [Warranty Status]='Out Of Warranty'")
Me.NonAWA.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='AWA' and [Warranty Status]='Out Of Warranty'")
Me.NonPPW.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='PPW' and [Warranty Status]='Out Of Warranty'")
Me.NonNAF.Caption = DCount("[Warranty Status]", "Backlog", "[Current Status]='NAF' and [Warranty Status]='Out Of Warranty'")


This code works wonderfully, unfortunately however, it is very slow, taking nearly a minute to load. This code is run in the On Open event on my switchboard, so it is the first thing to load when the database is opened, and since it is so slow, it is very unattractive. Is there anyway I can streamline this code, so that it loads faster? Any help is greatly appreciated, and just let me know if you need more information, or anything I typed is unclear. Thanks!

 

[ZmrAbdulla]

You can do it by enabling the timer event of the form. So the form will load faster then calculate....

Private Sub Form_Open(Cancel As Integer)
    Me.TimerInterval = 2000
End Sub
'===================================
Private Sub Form_Timer()
'Do your calculation
    MsgBox "It is time to do calculation"

    'Clear timer interval
    Me.TimerInterval = 0
End Sub

Hope this helps

________________________________________
Zameer Abdulla
Visit Me
Minds are like parachutes. They only function when they are open. -Sir James Dewar (1877-1925)

 

[Trevil]

One problem is the use of 'DCount' (search for 'Access performance Dcount').

How about changing your code to use a query that has 'Totals', 'Count' the desired records and 'Group By' on the desired fields. Then just move the totals to the captions??

"Hmmm, it worked when I tested it....

 

[sunmorgus]

To ZmrAbdulla: I would do that, but unfortunately, when I run this code it causes the whole database to lock up, so even then it causes problems with the people using the database. And I need this code to run often, to keep the fields updated.

Trevil: I don't know if this will work, as I already have a separate query assigned to this form. I hope I don't sound stupid for saying this, but I don't think I can get each separate label to link to a different query. If I am wrong please let me know. Thanks!

 

[Trevil]

Captions are not 'bound' to a query, so you can set them at any time. I would suggest that you create a function in your form that runs a query that returns the totals that you want and then sets the captions of your labels. Then I would remove the existing code you have and replace that with a call to your new function. This call can also be added to any place you need to refresh the captions (or you could have a Form_Timer event do it every n seconds).

I would first test the query to see how long it runs as compared to your current method. If acceptable performance, then proceed.

Basically, your function would be something like:

Dim sSQL as string
Dim rs as dao.recordset

sSQL = "Select **** count, group by, etc"
Set RS = CurrentDB.Openrecordset (pSQL)
Do while not rs.eof
If rs![Current Status] = "WIP" and rs![Warranty Status]= "Under Warranty" Then Me.WarWIP.Caption = RS!MyCount
.
.
.


rs.movenext
Loop
rs.close
set rs = nothing


"Hmmm, it worked when I tested it....

 

[sunmorgus]

so my code would look like this?

Option Compare Database

Dim sSQL As String
Dim rs As dao.Recordset

sSQL = "SELECT [Work Orders].[Warranty Status], Count([Work Orders].[Received Date]) AS [CountOfReceived Date], Switch([Proccessing Date],"
sSQL = sSQL + "'PPW',[Repair Fee Approval Receipt Date],'WIP',[Repair Fee Approval Issue Date],'AWA',([Bench Date] And [Analysis "
sSQL = sSQL + "Receipt Date]),'WIP',([Received Date] And [Analysis Fee Receipt Date]),'AWM',True,'NAF') AS [Current Status]"
sSQL = sSQL + "FROM Serialization INNER JOIN (RMAs INNER JOIN [Work Orders] ON RMAs.[RMA Number] = [Work Orders].[RMA Number]) ON Serialization.[Serial Number ID] = [Work Orders].[Serial Number ID]"
sSQL = sSQL + "WHERE ((([Work Orders].[Closed Date]) Is Null) AND (([Work Orders].[Received Date]) Is Not Null))"
sSQL = sSQL + "ORDER BY Switch([Proccessing Date],'PPW',[Repair Fee Approval Receipt Date],'WIP',[Repair Fee Approval Issue Date],'AWA',([Bench Date] And [Analysis Fee Receipt Date]),'WIP',([Received Date] And [Analysis Fee Receipt Date]),'AWM',True,'NAF');"

Set rs = CurrentDb.OpenRecordset(pSQL)
Do While Not rs.EOF
If rs![Current Status] = "WIP" And rs![Warranty Status] = "Under Warranty" Then Me.WarWIP.Caption = rs!MyCount
If rs![Current Status] = "AWM" And rs![Warranty Status] = "Under Warranty" Then Me.WarAWM.Caption = rs!MyCount
If rs![Current Status] = "AWA" And rs![Warranty Status] = "Under Warranty" Then Me.WarAWA.Caption = rs!MyCount
If rs![Current Status] = "PPW" And rs![Warranty Status] = "Under Warranty" Then Me.WarPPW.Caption = rs!MyCount
If rs![Current Status] = "NAF" And rs![Warranty Status] = "Under Warranty" Then Me.WarNAF.Caption = rs!MyCount
If rs![Current Status] = "WIP" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonWIP.Caption = rs!MyCount
If rs![Current Status] = "AWM" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonAWM.Caption = rs!MyCount
If rs![Current Status] = "AWA" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonAWA.Caption = rs!MyCount
If rs![Current Status] = "PPW" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonPPW.Caption = rs!MyCount
If rs![Current Status] = "NAF" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonNAF.Caption = rs!MyCount


rs.MoveNext
Loop
rs.Close
Set rs = Nothing

 

[Trevil]

Since I can't evaluate the results of your query, I can only ask if you run the query manually, do you receive the rows back that provide the correct summarization you need?
If so, then your code should be fine with the only exception being if you have NO records for a particular caption. If that is a possibility, you could always spin through all of the captions before running the query and reset all to zero.


"Hmmm, it worked when I tested it....

 

[sunmorgus]

so I would basically set a default value of 0 to all of my captions, using code?

 

[Trevil]

Yes, if it is possible some records will be missing (thus meaning you would have a ZERO answer), you will need to set the caption to 0. The easies way would be to insert
Me.WarWIP.Caption = 0
for each caption at the START of your function.

"Hmmm, it worked when I tested it....

 

[sunmorgus]

Ok, I will do that and post back if it works. Thanks!

 

[sunmorgus]

ok, here is the final code, and it seems to work, accept it appears that the query does not return a result for every record, i get a "Item not found in this collection" error. is there anyway I can get the code to skip said line if there is no records for it, and go with the default of 0?

Dim strVerFE As Integer
Dim strVerMain As Integer
Dim sSQL As String
Dim rs As dao.Recordset

DoCmd.OpenForm "frmkeepopen", acNormal, , , , acHidden

Me.WarWIP.Caption = 0
Me.WarAWM.Caption = 0
Me.WarAWA.Caption = 0
Me.WarPPW.Caption = 0
Me.WarNAF.Caption = 0
Me.NonWIP.Caption = 0
Me.NonAWM.Caption = 0
Me.NonAWA.Caption = 0
Me.NonPPW.Caption = 0
Me.NonNAF.Caption = 0

strVerFE = Nz(DLookup("[Version]", "[tblVersionFE]"), "")
strVerMain = Nz(DLookup("[Version]", "[tblVersionMain]"), "")

If strVerMain > strVerFE Then
MsgBox "This database needs to be updated." & (Chr(13)) & "After updating, please reopen the database. Thanks!", vbInformation
Call Shell("t:\Database Project\CustSuptUpdt.bat", 1)
Quit
End If


sSQL = "SELECT [Work Orders].[Warranty Status], Count([Work Orders].[Received Date]) AS [CountOfReceived Date], Switch([Proccessing Date],'PPW',[Repair Fee Approval Receipt Date],'WIP',[Repair Fee Approval Issue Date],'AWA',([Bench Date] And [Analysis Fee Receipt Date]),'WIP',([Received Date] And [Analysis Fee Receipt Date]),'AWM',True,'NAF') AS [Current Status]" & _
"FROM Serialization INNER JOIN (RMAs INNER JOIN [Work Orders] ON RMAs.[RMA Number] = [Work Orders].[RMA Number]) ON Serialization.[Serial Number ID] = [Work Orders].[Serial Number ID]" & _
"WHERE ((([Work Orders].[Closed Date]) Is Null))" & _
"GROUP BY [Work Orders].[Warranty Status], Switch([Proccessing Date],'PPW',[Repair Fee Approval Receipt Date],'WIP',[Repair Fee Approval Issue Date],'AWA',([Bench Date] And [Analysis Fee Receipt Date]),'WIP',([Received Date] And [Analysis Fee Receipt Date]),'AWM',True,'NAF')" & _
"HAVING (((Count([Work Orders].[Received Date])) Is Not Null))" & _
"ORDER BY Switch([Proccessing Date],'PPW',[Repair Fee Approval Receipt Date],'WIP',[Repair Fee Approval Issue Date],'AWA',([Bench Date] And [Analysis Fee Receipt Date]),'WIP',([Received Date] And [Analysis Fee Receipt Date]),'AWM',True,'NAF');"

Set rs = CurrentDb.OpenRecordset(sSQL)
Do While Not rs.EOF
If rs![Current Status] = "WIP" And rs![Warranty Status] = "Under Warranty" Then Me.WarWIP.Caption = rs!MyCount
If rs![Current Status] = "AWM" And rs![Warranty Status] = "Under Warranty" Then Me.WarAWM.Caption = rs!MyCount
If rs![Current Status] = "AWA" And rs![Warranty Status] = "Under Warranty" Then Me.WarAWA.Caption = rs!MyCount
If rs![Current Status] = "PPW" And rs![Warranty Status] = "Under Warranty" Then Me.WarPPW.Caption = rs!MyCount
If rs![Current Status] = "NAF" And rs![Warranty Status] = "Under Warranty" Then Me.WarNAF.Caption = rs!MyCount
If rs![Current Status] = "WIP" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonWIP.Caption = rs!MyCount
If rs![Current Status] = "AWM" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonAWM.Caption = rs!MyCount
If rs![Current Status] = "AWA" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonAWA.Caption = rs!MyCount
If rs![Current Status] = "PPW" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonPPW.Caption = rs!MyCount
If rs![Current Status] = "NAF" And rs![Warranty Status] = "Out Of Warranty" Then Me.NonNAF.Caption = rs!MyCount


rs.MoveNext
Loop
rs.Close
Set rs = Nothing

 

[Trevil]

1. Did you run your query manually?
2. Did it return the records you expected?
3. If 1 & 2 are "YES", then what line of code is producing the error?
4. Is your query returning null values for either field "Current Status" or "Warranty Status"? If so, replace the:
If rs![Current Status] = xxx And rs![Warranty Status] = yyy
with:
If NZ(rs![Current Status]) = xxx And NZ(rs![Warranty Status]) = yyy




"Hmmm, it worked when I tested it....

 

[sunmorgus]

1 & 2 are a yes. I replaced current status and warranty status with the nz code, and I still get the error; however, vb highlights the "Me.NonNAF.Caption = rs!MyCount" section of the code now when I go to debug the error. This may have nothing to do with it, but I thought I would let you know.

as a side note, how does the "rs!MyCount" work. Is MyCount something I need to tell Access what to do with? I just went back up and reviewed this in my code above, and something does not seem right about it...

 

[sunmorgus]

hehe, that was it...MyCount was supposed to be set as [CountofReceived Date]. That was my stupid mistake. Thanks so much for the help!

 

[Trevil]

OOOPPPSSS!!! MyCount was just an example that I used. You will need to substitute the actual field name returned by your query that contains the counts that you want to place in the captions.

Sorry.

"Hmmm, it worked when I tested it....

 

[sunmorgus]

Not a problem, thanks again for the help!