?
Solved

speed up rst update

Posted on 2011-04-29
4
Medium Priority
?
277 Views
Last Modified: 2012-05-11
I have a function that I had assistance with from an expert. its taking a long time I have about 4300 records to cycle through it takes about 1 second per client code on a quad core.

I wonder if there is a way without having to lop througgh again where I have marked with asterisks

remmed as 'now cycle and update multiple rows for each client code
    '' this is doubling the time taken to cycle through records.

that could cut the processing time in half
Public Function getFailureString()
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
Dim strQuery As String
Dim strSelectOuter As String
Dim strFromOuter As String
Dim strGroupByOuter As String
Dim strHavingOuter As String
Dim strQueryOuter As String
Dim strOutput As String
Dim db As Database
Set db = CurrentDb
Dim RstOuter As DAO.Recordset
Dim RStFailures As DAO.Recordset
Dim ClientCodeMvris As String
Dim rcount As Integer
Dim indexcount As Integer
Dim RstResultTable As DAO.Recordset
Dim strtest As String

strSelectOuter = "SELECT TblAbiTestResults.AbiCodeMvris, TblAbiTestResults.TestResult"
strFromOuter = " FROM TblAbiTestResults"
strGroupByOuter = " GROUP BY TblAbiTestResults.AbiCodeMvris, TblAbiTestResults.TestResult"
strHavingOuter = " HAVING (((TblAbiTestResults.TestResult)=0));"
strQueryOuter = strSelectOuter & strFromOuter & strGroupByOuter & strHavingOuter

Set RstOuter = db.OpenRecordset(strQueryOuter)
Set RstResultTable = db.OpenRecordset("TblAbiTestResults")

'inner
strSelect = "SELECT TblAbiTestResults.AbiCodeMvris, TblAbiTestResults.TestResult, TblAbiTestResults.TestDescription, TblAbiTestResults.strResult"
strFrom = " FROM TblAbiTestResults"

ProcessCounter = 0


'get record count to later deal with comma at end issue ie if next record end dont add comma to string
RstOuter.MoveLast
rcount = RstOuter.RecordCount
RstOuter.MoveFirst

With RstOuter
.MoveFirst
'loop records in outer
Do While .EOF <> True
    'get the clientcodemvris combination
     ClientCodeMvris = .Fields("AbiCodeMvris").Value
'     Debug.Print .Fields("AbiCodeMvris").Value
    'create query based on clientcode
     strWhere = " WHERE (((TblAbiTestResults.AbiCodeMvris)=""" & ClientCodeMvris & """) AND ((TblAbiTestResults.TestResult)=0));"
    'create string
    strQuery = strSelect & strFrom & strWhere
'     Debug.Print strQuery
    Set RStFailures = db.OpenRecordset(strQuery, dbOpenDynaset)
    RStFailures.MoveLast
    rcount = RStFailures.RecordCount
    indexcount = 0
'    Debug.Print strQuery
    RStFailures.MoveFirst
    With RStFailures
    .MoveFirst
           'check for no records
        If RStFailures.BOF And RStFailures.EOF Then
               
            Else
            
                Do While .EOF <> True
                    Select Case rcount
                        Case 1
                        'first record so no comma
                            strOutput = .Fields("testdescription").Value
                            Case Is > 1
                            'not first record so check position and add comma where necessary
                            If indexcount = 0 Then
                            'first record so value as is
                                strOutput = .Fields("testdescription").Value
                            Else
                             'not first record so add comma
                                strOutput = strOutput & ", " & .Fields("testdescription").Value
                            End If
                        End Select
                    .MoveNext
                    indexcount = indexcount + 1
                Loop
    
    
    'now cycle and update multiple rows for each client code
    '' this is doubling the time taken to cycle through records.
    '*********************************************************
    
            .MoveFirst
            Do While .EOF <> True
                .Edit
                .Fields("strresult").Value = strOutput
                .Update
                .MoveNext
            
            Loop
    '***************************************************************
       
    
    
        End If

    End With
 'reset string
    strOutput = ""
    indexcount = 0
'incremenent status bar indicator so we know what record is processing

   ProcessCounter = ProcessCounter + 1
   'move to next outer record
    .MoveNext
 'update status bar
strtest = SysCmd(acSysCmdSetStatus, "CWCode Count: " & CStr(ProcessCounter))
Loop

End With

End Function

Open in new window

0
Comment
Question by:PeterBaileyUk
  • 2
4 Comments
 
LVL 2

Accepted Solution

by:
ComputerAidNZ earned 2000 total points
ID: 35489953
Is it possible to attach the complete mdb file so we can step though it and mull it over, if not ctreate a DB with the relevant table, query and records.
0
 

Author Comment

by:PeterBaileyUk
ID: 35490070
ok i have cut out most objects to reduce size of db so run function from immediate window

The reason i am creatting he string and updateing the test table is that I have a main form with a subform that contains my data and the subform client data. I want to use conditional formatting to show on the form what had failed so I can use the string to do that so that for example if bhp failed then my bhp and the client bhp field would show highlighted.




AbiPostMatchValidator---Copy.mdb
0
 
LVL 24

Expert Comment

by:Bitsqueezer
ID: 35500233
Hi,

1. use indices on all queried columns ("AbiCodeMvris" for example) - it takes around 2 seconds for one query like this:
SELECT AbiCodeMvris, TestResult,
TestDescription, strResult
FROM TblAbiTestResults 
WHERE (((TblAbiTestResults.AbiCodeMvris)="00800201L7CLB") 
AND ((TblAbiTestResults.TestResult)=0));

Open in new window

After adding an index on "AbiCodeMvris" it takes only some microseconds. Complete function now only takes around 8 seconds.
2. Save all queries, don't use VBA strings to assemble SQL strings if not really needed, especially if it is a query which never changes. So in this case save a query for:
SELECT AbiCodeMvris, TestResult
FROM TblAbiTestResults
GROUP BY AbiCodeMvris, TestResult
HAVING (((TestResult)=0));

Open in new window

Let's say it's "QryAbiGroups".
3. As this also uses an additional column to search ("TestResult"), also add an index here which fastens this query.
4. You have a lot of code in your function which is not needed, it can be shortened and fastened with this result:

Public Function getFailureString()
    Dim strOutput As String
    Dim db As Database
    Dim RstOuter As DAO.Recordset
    Dim RStFailures As DAO.Recordset
    Dim qd As DAO.QueryDef
    Dim StartTime As Date

    Set db = CurrentDb
    Set RstOuter = db.OpenRecordset("QryAbiGroups")
    Set qd = db.QueryDefs("QryOne")

    StartTime = Now()
    With RstOuter
        .MoveFirst
        'loop records in outer
        Do While .EOF <> True
            'run query based on clientcode
            qd.Parameters("strAbiCodeMvris") = .Fields("AbiCodeMvris")
            Set RStFailures = qd.OpenRecordset(dbOpenDynaset)
            
            With RStFailures
                .MoveFirst
                'check for no records
                If Not (RStFailures.BOF And RStFailures.EOF) Then
                    'reset string
                    strOutput = ""
                    Do While Not .EOF
                        strOutput = strOutput & RStFailures.Fields("TestDescription") & ", "
                        .MoveNext
                    Loop
                    If Len(strOutput) > 2 Then strOutput = Left(strOutput, Len(strOutput) - 2)

                    'now cycle and update multiple rows for each client code
                    .MoveFirst
                    Do While Not .EOF
                        .Edit
                        .Fields("strResult").Value = strOutput
                        .Update
                        .MoveNext
                    Loop
                End If
            End With
            'move to next outer record
            .MoveNext
        Loop
    End With
    If Not RstOuter Is Nothing Then
        RstOuter.Close
        Set RstOuter = Nothing
    End If
    If Not RStFailures Is Nothing Then
        RStFailures.Close
        Set RStFailures = Nothing
    End If
    Debug.Print DateDiff("s", StartTime, Now())
End Function

Open in new window


This one measures the time it takes and gives you an info at the end. It takes around 7 seconds at my computer now, I also removed the status bar display which also slows down the result. As it is fast enough now the display is not needed anymore, it is enough to show the user "please wait" or anything like this.

5. You could also use SQL to update your result by using a simple VBA function which assembles the CSV string. This is the UPDATE command you would need which calls this VBA function:

UPDATE TblAbiTestResults SET TblAbiTestResults.strResult = fnTestResultCSVList([AbiCodeMvris])
WHERE (((TblAbiTestResults.TestResult)=0));

Open in new window


Save it as "QryChangeStrResult", then you can use this code to execute it, it also measures the time it takes and it executes in 5 seconds at my computer:

Private rsCSV As DAO.Recordset
Private qdCSV As DAO.QueryDef

Public Sub getFailureString2()
    Dim StartTime As Date
    
    StartTime = Now()
    
    Set qdCSV = CurrentDb.QueryDefs("qryOne")
    CurrentDb.Execute "QryUpdateStrResult"
    Set qdCSV = Nothing
    Debug.Print DateDiff("s", StartTime, Now())
End Sub

Public Function fnTestResultCSVList(strAbiCodeMvris As String) As String
'    Static lngCounter As Long
    Dim strOutput As String
    
    qdCSV.Parameters("strAbiCodeMvris") = strAbiCodeMvris
    Set rsCSV = qdCSV.OpenRecordset(dbOpenForwardOnly, dbReadOnly)
    With rsCSV
        If Not rsCSV Is Nothing Then
            If Not (.BOF And .EOF) Then
                Do While Not .EOF
                    strOutput = strOutput & .Fields("TestDescription") & ", "
                    .MoveNext
                Loop
                If Len(strOutput) > 2 Then strOutput = Left(strOutput, Len(strOutput) - 2)
            End If
        End If
        fnTestResultCSVList = strOutput
        If Not rsCSV Is Nothing Then
            .Close
            Set rsCSV = Nothing
        End If
    End With
'    lngCounter = lngCounter + 1
'    SysCmd acSysCmdSetStatus, "CWCode Count: " & CStr(lngCounter)
End Function

Open in new window


If you want to display the rows which are executed you can remove the three single quotes from the lines in the function "fnTestResultCSVList" but this will slow down the result a lot (takes 9 seconds at my computer).

You see: Everywhere where it is possible don't use recordsets - in most cases you can use SQL to achieve the wanted result. The CSV function is one of the examples where you unfortunately need a recordset as there is no comparable function in SQL (also not in SQL Server so Access is not the only database with this problem). But where needed, call it inside of a SQL command like here in the UPDATE command and not in another recordset loop. As the function is called very often, it is better to declare the variables for recordset and querydef on module level and initialize it once in an extra function like here in "getFailureString2" so it must not be initialized again in every loop - the function "fnTestResultCSVList" only changes the parameter for the querydef and execute it again which is faster than reinitialize it in every call to the function.

Finally, here the query "QryOne" used in both versions above:

PARAMETERS strAbiCodeMvris Text ( 255 );
SELECT TestDescription, strResult
FROM TblAbiTestResults
WHERE (((AbiCodeMvris)=strAbiCodeMvris) AND ((TestResult)=0));

Open in new window


In variant "getFailureString2" you could also leave out the column "strResult" from this query as it will not be needed to update the result anymore, this is done by the UPDATE command.

Cheers,

Christian
0
 
LVL 24

Expert Comment

by:Bitsqueezer
ID: 35500456
Hi,

not that I want to fight for points...:-)
But is it possible that you only saw the blue t-shirt of the avatar and not the name?...;-)
If "ComputerAidNZ" has posted another solution via email in the meantime than it's of course OK for me.

Cheers,

Christian
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question