Is there a timer to troubleshoot possible loop problem?

[morphus]

I have VBA code in access 2007 that's been running unexpectedly over 24hrs. Whenever I issue 'ctrl+break' to check progress and step through code with F8 all appears well although msaccess reports it is 'not responding'.

When I first saw the 'not responding' I stopped the app, checked the code and results, the results table contains the data I am seeking. At the pace the code is running, the app may be running another 12hrs!

The only thing I can think of now is to insert a timer of some sort to determine where I am wasting resources. Is there code I can place with the loopcounter to determine the length of time the loop took to process a record?

Code snippet:

MySQL = "SELECT bpa_productTemp.site, bpa_productTemp.productName, bpa_productTemp.yr, bpa_productTemp.mo, bpa_productTemp.productPercentage FROM bpa_productTemp ORDER BY bpa_productTemp.site, bpa_productTemp.productName, bpa_productTemp.productMonthReported;"

Set db = CurrentDb
Set rstA = db.OpenRecordset(MySQL)
Set rstB = db.OpenRecordset("bpa_product_monthly", dbOpenDynaset)

recordsetupdatable = True

rstA.MoveFirst
rstA.MoveLast
rstA.MoveFirst
    
With rstA
    Do Until .EOF
        
        rstB.FindFirst "[site] = '" & !site & "' AND [yr] = " & !yr & " AND [productName] = '" & !productName & "' "
        
        If rstB.NoMatch Then
                rstB.AddNew
                rstB!site = !site
                rstB!yr = !yr
                rstB!productName = !productName
        Else
                rstB.Edit
                rstB!site = !site
                rstB!yr = !yr
                rstB!productName = !productName
        End If
        
        Select Case !mo
            Case "Jan"
                rstB!jan = !productPercentage
            Case "Feb"
                rstB!feb = !productPercentage
            Case "Mar"
                rstB!mar = !productPercentage
            Case "Apr"
                rstB!apr = !productPercentage
            Case "May"
                rstB!may = !productPercentage
            Case "Jun"
                rstB!jun = !productPercentage
            Case "Jul"
                rstB!jul = !productPercentage
            Case "Aug"
                rstB!aug = !productPercentage
            Case "Sep"
                rstB!sep = !productPercentage
            Case "Oct"
                rstB!Oct = !productPercentage
            Case "Nov"
                rstB!nov = !productPercentage
            Case "Dec"
                rstB!dec = !productPercentage
        End Select
                
        rstB.Update
        rstB.Bookmark = rstB.LastModified
        
        .MoveNext
        
        loopcount = loopcount + 1
        If loopcount Mod 100 = 0 Then
            DoCmd.Echo True, 1
        End If

    Loop
End With

 

[vbaInet]

With the FindFirst, AddNew and MoveNext actions, I don't think your code will ever stop.

 

[morphus]

My goal is, foreach rstA record, determine whether rstA's product+site+yr record exist in rstB, if rstB rec is found, update the monthly percentage, otherwise, create the record. Do you see a conflict which prevents this from occurring?

 

[vbaInet]

Oops... I didn't realise you were working with two recordsets. I should learn to read full code than just skim through it

I made some amendments:

Set db = CurrentDb
Set rstA = db.OpenRecordset("SELECT * FROM bpa_productTemp ORDER BY site, productName, productMonthReported;")

recordsetupdatable = True
    
With rstA
    Do While Not .EOF
        Set rstB = db.OpenRecordset("SELECT * FROM bpa_product_monthly " & _
                                    "WHERE [site] = '" & !site & "' AND [yr] = " & !yr & " AND [productName] = '" & !productName & "';", dbOpenDynaset)
        
        If rstB.RecordCount = 0 Then
             rstB.AddNew
             rstB!site = !site
             rstB!yr = !yr
             rstB!productName = !productName
        Else
             rstB.MoveFirst
             rstB.Edit
             rstB!site = !site
             rstB!yr = !yr
             rstB!productName = !productName
        End If
        
        rstB.Fields(!mo) = !productPercentage
                
        rstB.Update
        
        .MoveNext
        
        ' loopcount = loopcount + 1
        ' If loopcount Mod 100 = 0 Then
        '    DoCmd.Echo True, 1
        ' End If

    Loop
End With

set rstB = Nothing
set rstA = Nothing
set db = Nothing

 

[morphus]

Thanks for reply. Will update to amendments.

 

[vbaInet]

Thanks for reply. Will update to amendments.

By the way, get rid of these lines:

        Else
             rstB.MoveFirst
             rstB.Edit
             rstB!site = !site
             rstB!yr = !yr
             rstB!productName = !productName

Redundant!

 

[morphus]

Thanks for update. Happy to report the process finished the remaining 200,000 records within minutes not hours! Thank you!!!

 

[vbaInet]

Excellent!!

More tips for refinement would be to create an update query that will perform the update and insert processes instead of using looping through recordsets. You will notice significant improvement.

 

[JANR]

Excellent!!

More tips for refinement would be to create an update query that will perform the update and insert processes instead of using looping through recordsets. You will notice significant improvement.

something like this perhaps

aircode:

CurrentDb.Execute " UPDATE bpa_productTemp AS A LEFT JOIN bpa_product_monthly AS B ON A.ID = B.ID " & _
                  " SET B.site = A.site, B.yr = A.yr, B.ProductName = A.ProductName;", dbFailOnError

JR

 

[vbaInet]

Actually, it seems the OP doesn't need to update the record because if it exists then there's no point repeating the process. So just an append will be sufficient. Something like this (aircode):

dim db as Dao.database

Set db = Currentdb

db.execute "INSERT INTO bpa_product_monthly " & _
                "SELECT A.* FROM bpa_productTemp AS A " & _
                "WHERE (Not Exists " & _
                     "(SELECT B.* FROM bpa_product_monthly AS B " & _
                     "WHERE B.[site] & '' = A.[site] & '' AND B.[yr] = A.[yr] AND B.[productName] & '' = A.[productName] & ''));

msgbox db.recordsaffected & " records inserted!", vbInformation + vbOKOnly, "Append successful"

 

[JANR]

Yeah if there are only new records in the temptable which needs to be added to the product table, then ther is no need to update.

But if there could be that some of the records have some changes like a updated site then my bruteforce attack takes care of both.

The only requirement is that there is a ID field I can join against.

Anyhow both methodes should get better performance than a looping recordset.

JR

 

[vbaInet]

But if there could be that some of the records have some changes like a updated site then my bruteforce attack takes care of both.

I get you , but the requirement is if there's no match, insert the record -->

My goal is, foreach rstA record, determine whether rstA's product+site+yr record exist in rstB, if rstB rec is found, update the monthly percentage, otherwise, create the record.

Therefore, if there is a change in one of the fields, there will be no match so a new record needs to created.