asked on

VBA Bombs Error 3052 Updating Record Set

How can I get the code to run faster and run with out bombing. I have over 1 million records, database is 1.28 gig.

Function UpdateCumuMissing()

'On Error GoTo Error123

Dim db As DAO.Database
Dim rs, Rst As DAO.Recordset
Dim Matchkey As String
Dim i, j, k As Integer
Dim Monthkey As String
Dim txtyyyyMM As String

'i = 0
  Set db = CurrentDb
  Set rs = db.OpenRecordset("Qry_UP_MissingIxosCertReview", dbOpenDynaset)
  

    rs.MoveFirst
    Matchkey = rs!sys_cust_St
    txtyyyyMM = Format(rs!yyyymm, "@@@@_@@")
    'Monthkey = ReviewCertKey(txtyyyyMM, Matchkey)
    
While Not rs.EOF
  'i = i + 1
  
  'Select Case i
  'Case Is = 10000, 50000, 100000, 200000, 300000, 500000
  'MsgBox i / rs.RecordCount & "    " & i
  'End Select
  
  
    Set Rst = db.OpenRecordset("SELECT [" & txtyyyyMM & "] As Expr1 FROM tbl_Customer_Certs WHERE (Sys_cust_st ='" & Matchkey & "')")
    
    Monthkey = Rst!Expr1
    'SELECT [" & Txtyyymm & "]* FROM tbl_Customer_Certs WHERE (Sys_cust_st ='" & matchkey & "')")
  
  
  'rs.Update
  rs.Edit
  rs!IxosCertDateMatch = Monthkey
  'rs!AnotherField = SomeOtherValue
  rs.Update
  rs.MoveNext
  Set Rst = Nothing
Wend
  Set rs = Nothing
  Set db = Nothing
MsgBox "Complete"



MsgBox "Complete"

ErrorExit:
    Exit Function
Error123:
    Set Rst = Nothing
    Set rs = Nothing
    Set db = Nothing
    MsgBox Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
Resume ErrorExit


End Function

Open in new window

peter57r

I think this is two distinct questions.
What error is being produced and on what line does it occur?

Dale Fye

The first step would be to write an update query, instead of opening a recordset and looping through it record by record.

The other thing I'm concerned with is that you are setting MatchKey and txtYYYYMM based on rs, but do this outside the loop for that recordset. Does this mean that every record in "Qry_UP_MissingIxosCertReview" contains the same values for MatchKey and txtYYYYMM? If not, then you need to move those lines inside of the While Not rs.EOF/Wend loop.

Does your rst recordset only return a single value? If so, why are you using that instead of a DLOOKUP()? If not, why aren't you looping through that recordset as well?

UWW_Jax

ASKER

OKay, I'd tryied difference approaches. Here's how the data works.

I have two main tables.

Tbl_Customer_Certs. This has a listing of sys_cust_st (refering to matchkey) with all of the YYYY_MM' s listed as a column from 2006 through 2021. These fields are true/False check boxes.

Tbl_CumulativeMissing This contains sales details with tons of columns that I have narrowed down to three columns need for this exercise I have put into Qry_UP_MissingIxosCertReview which are Sys_cust_st, YYYYMM, and IxosCertDateMatch.

This Idea is to loop through the million records of Qry_UP_MissingIxosCertReview and for each line look for the YYYYMM reference in the Tbl_customer_Certs column setup as YYYY_MM.

If there is no match between the tables I need to put NoDoc into IxosCertDateMatch field

If there is a match between the tables and the YYYY_M is blank/no checked, I need to put Unmatched into IxosCertDateMatch field

If there is a match between the tables and the YYYY_M is -1/checked, I need to put matched into IxosCertDateMatch field

I had a Function that did a dlookup for and then updated based upon the finding, but I could not get it to perform quick.

I just ran the code again to tell you the error, and it completed after 5/10 minutes.

I was thought that code runs faster than update queries because of the lookup format issues with mass data.

Function ReviewCertKey(xmonth, xmatchkey As String) As String
Dim txtReview, txtFound As String
txtReview = "NoDoc"

xmonth = "[" & Format(xmonth, "@@@@_@@") & "]"

Select Case Nz(DLookup(xmonth, "Tbl_Customer_Certs", "[sys_cust_st]='" & xmatchkey & "'"), txtReview)

Case Is = -1
txtFound = "Match"
Case Is = 0
txtFound = "UnMatched"
Case Is = txtReview
txtFound = txtReview
End Select

'ReviewCertKey = Nz(DLookup("[" & Format(xmonth, "@@@@_@@") & "]", "Tbl_Customer_Certs", "[sys_cust_st]='" & xmatchkey & "'"), txtReview)
ReviewCertKey = txtFound


End Function

Open in new window

UWW_Jax

ASKER

I was also using a qry to sort and pick a selection of data to test rather than running on the population.

Dale Fye

Can you provide a sample database with a subset of each of these tables, the query you are using, and a sample of what the result this process would generate?

You could do this with a couple of make-table queries to select a small subset (5-10 records) from each table, then copy these tables into a new mdb, along with the query you were using above. Then make a copy of tbl_CumulativeMissing and fill in the [rs!IxosCertDateMatch] column for each of those records

ASKER CERTIFIED SOLUTION

UWW_Jax

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Dale Fye

Please provide a sample database as indicated above. Without it, I'm just spinning my wheels.

UWW_Jax

ASKER

I have attached a database where as 75% of the items in the CumulativeMissing table has been deleted due to sight size limitations.
Copy-of-STAR-3.0.accdb

UWW_Jax

ASKER

Never Received a followup response. Closing issue