Counting by Company by recordset resource issue

[sxschech]

I was asked to write some code to provide a counter that would count by company and reset for a new company. As they want to be able to query off that and export the results for example Company A may have 10 rows (1 - 10), company B 3 rows (1 - 3), Company C 18 rows (1 - 18), Company D 1 row. They would then decide "I'd like a max of 5 rows per company", they would then get 5 rows from Company A, 3 rows from B, 5 from C and 1 from D. I looked at various queries to do this, but due to size of source tables, decided to add a numeric col to the table and populate via recordset incrementing by 1 until a new company name appears, then resetting 1 to and increment again. I have two summary queries and a form with subforms that show how many rows companies have and then by company how many rows.
For example, 1st query shows 38 2, this means there are 2 companies that have 38 rows. The 2nd query provides the names of the companies.
User then selects from the drop down and that then saves the results to a table or exports to excel.

At home I have Access 2013 and the code works fine (so far), but at the office, they have 2010 and after about 20,000 rows it says system resources exceeded. The table becomes corrupt because when I try to open it manually it says system resources exceeded and becomes #name.

I've looked at various threads and tried some of the solutions, so far I haven't gotten them to work in my case. Could the problem be because I'm altering the table in the back end? Perhaps someone may have another idea.

Public Sub CompanyCount()
    'Create a column to count up number of rows
    'in a company and then reset counter for
    'next company to be used by query to filter
    'specified number of rows for each company
    'such as "Select 10 rows from each company"
    'http://www.granite.ab.ca/access/backendupdate.htm
    '20150522
    
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim td As DAO.TableDef
    Dim fld As DAO.Field
    Dim rs As DAO.Recordset
    Dim stsql As String
    Dim stCompany As String
    Dim stFindCompany As String
    Dim intCounter As Long
    Dim stTableName As String
    Dim Position As Long
    Dim myvalue As Long
    
    Me.btnProcess.Caption = "Generating Counts"
    Me.btnProcess.ForeColor = vbRed
    On Error GoTo msgerr
    
    Set db = CurrentDb
    
    'This line allows processing more than 9000 records without
    'getting the dreaded "Run-Time error '3052' ;
    'File sharing lock count exceeded. Increase you MAXLocksPerFile Registry Entry"
    'http://www.access-programmers.co.uk/forums/showthread.php?t=185985
    '20150529
    DAO.DBEngine.SetOption dbMaxLocksPerFile, 500000
    
    myvalue = 0
    If IsNull(Me.cboPreview) Then
        MsgBox "Choose an input table before proceeding.", vbOKOnly, "Missing Input Table"
        Exit Sub
    End If
    If fieldexists(Me.cboPreview, "COUNTER") Then
         stsql = "UPDATE " & Me.cboPreview & " SET COUNTER = '' " & _
                    "WHERE COUNTER Is Not Null"
            CurrentDb.Execute stsql
    Else
        Set db = DBEngine(0).OpenDatabase(Me.txtProject, True)
        Set td = db.TableDefs(Me.cboPreview)
        Set fld = td.CreateField("COUNTER", dbLong)
        td.Fields.Append fld
        Set fld = Nothing
        Set td = Nothing
    db.Close
        Set db = Nothing
        Set db = CurrentDb
    End If
    
    stsql = "SELECT * FROM " & Me.cboPreview & " ORDER BY COMPANY" 
    Set rs = db.OpenRecordset(stsql)
    
    With rs
        .MoveLast
        .MoveFirst
        stCompany = rs!Company
        intCounter = 0
        Do While Not rs.EOF
            If stCompany = rs!Company Then
                intCounter = intCounter + 1
            Else
                intCounter = 1
            End If
            stCompany = rs!Company
            Position = .AbsolutePosition
            .Edit
            rs!COUNTER = intCounter
            .Update
            .MoveNext
        Loop
    End With
    If QueryExists("qryCoCoByCompany") Then
            Set qd = db.QueryDefs("qryCoCoByCompany")
        Else
            Set qd = db.CreateQueryDef("qryCoCoByCompany")
    End If

    stsql = "SELECT COMPANY, Max(" & Me.cboPreview & ".COUNTER) AS COUNTER " & _
            "FROM " & Me.cboPreview & " " & _
            "GROUP BY COMPANY " & _
            "ORDER BY max(COUNTER) DESC, COMPANY;"
    qd.SQL = stsql

    If QueryExists("qryCoCoSums") Then
            Set qd = db.QueryDefs("qryCoCoSums")
        Else
            Set qd = db.CreateQueryDef("qryCoCoSums")
    End If

    stsql = "SELECT CSUMS.COUNTER, Count(CSUMS.COUNTER) AS No_Of_Companies " & _
            "FROM " & Me.cboPreview & " AS CSUMS " & _
            "INNER JOIN qryCoCoByCompany AS CNAMES " & _
            "ON CSUMS.COMPANY = CNAMES.COMPANY " & _
            "AND CSUMS.COUNTER = CNAMES.COUNTER " & _
            "GROUP BY CSUMS.COUNTER " & _
            "ORDER BY CSUMS.COUNTER DESC;"
    qd.SQL = stsql
    
    rs.Close
    Set rs = Nothing
    Set qd = Nothing
    Set db = Nothing
    Me.btnProcess.Caption = "Company Count (max count)"
    Me.btnProcess.ForeColor = vbBlack
    
    DoCmd.OpenForm "frmCompanyCount"
    
    Exit Sub
msgerr:
    MsgBox Err.Number & " " & Err.Description
End Sub

 

[namliam]

Only anomoly I can see is....
Position = .AbsolutePosition
Why would you need to know this?

 

[vbaInet]

Instead of injecting a numeric column field, you can do the following instead.

You will need a field that counts how many records there are per company - just a quick Totals Query with a Count aggregate would do.

Create a second inner loop that loops from 1 to MaxRecords, where MaxRecords is:

If !CountPerCustomer > 4 Then
    MaxRecords = 5
[COLOR="Blue"]    MoveCounter = !CountPerCustomer - 5[/COLOR]
Else
    MaxRecords = !CountPerCustomer
[COLOR="Blue"]    MoveCounter = 0[/COLOR]
End if

After the inner loop use the Recordset.Move() method to move it to the next Customer by using the MoveCounter variable highlighted above.

.Move([COLOR="blue"]MoveCounter[/COLOR])

 

[sxschech]

Hi namliam: I was using Position = .AbsolutePosition to try and tack down at how many rows before an error appears. I deleted the debug.print but forgot to comment or delete that one.

vbaInet: To clarify my understanding... I still will add a new numeric col to the table if it doesn't exist and then (create if doesn't exist)/use a summary query that has company name and max(count) of company name. This will become the source of a second recordset and in the existing code that is looping through the original recordset, I will use the code you provided, change the hardcoded values to the value returned by the second recordset to determine the point of resquence which will add the counter numbering sequence to the table. In effect, I won't be pre-numbering all the rows, this would be a "post decision cutoff sequencer", only up to the number of rows per company that the user chose? If so, under that scenario, the entire code will be run multiple times, because the user decides to try 5 then say, 'I didn't get enough rows' and then ask for 10.

 

[vbaInet]

Ok, let me re-do the process and expand a bit. The counter field will still remain.

1. Reset Counter field for all records by setting it to No (if it's a Yes/No field). You do this before you open any recordset.
2. Wait until step 1 finishes executing before you open any recordset... this would help eliminate the locks problem. Do this by checking the StillExecuting property of a querydef and running DoEvents:

Dim qdf as DAO.QueryDef

Set qdf = db.QueryDefs("[COLOR="Blue"]QueryName[/COLOR]")
With qdf
    .Execute dbFailOnError + dbRunAsync
    Do While .StillExecuting
        DoEvents
    Loop
End With

... at a much later stage add another loop inside the Do While loop to slow down the number of times DoEvents is called.
3. Create a Totals query to return a count per company.
4. Create an inner loop (based on a recordset of the Totals query in step 3) that loops from 1 to MaxRecords, where MaxRecords is:

If !CountPerCompany > 4 Then
    MaxRecords = 5
    [COLOR="blue"]MoveCounter[/COLOR] = !CountPerCompany - 5
Else
    MaxRecords = !CountPerCompany
[COLOR="Blue"]    MoveCounter[/COLOR] = 0
End if

... 5 indicates the number of records your client wants to return per company. You would have captured this somewhere. And 4 is just 5 - 1.
5. In the inner loop you will increment the Counter field
6. After the inner loop use the Recordset.Move() method on the outter loop to move it to the next Company by using the MoveCounter variable highlighted above.

.Move([COLOR="Blue"]MoveCounter[/COLOR])

7. At the end of it all, create a query that selects Not Null Counter records.

I'm hoping that this process is going be run by one person or at least not something that needs to be run often.

By the way, how many records are there? And what query options did you look into?

 

[sxschech]

To answer your questions, I'm not sure how often this will be run overall, it will however be run multiple times a session in order to determine how many rows to select. They may ask for 10 rows per company and get 20,000 qualifying rows and decide that is too much or too little and then try a different number. The thing about my original code was that once all the rows were numbered, the user could see the summarised results on the form, type in 10 and see instantaneously how many rows would be selected before actually outputting the data to a table or excel file.

Regarding query options I had looked at seeing if a query could do a running count grouped by company and also looked at TOP x.

The way they are doing it now, they may start out with a table of 100k rows, this gets filtered via a third party application and saved to a new table, so could be around 30 to 50k by the time they get to this step.

The stillexecuting code is used only when resetting the counter, yes? If that is the case, would I need it if I'm using CurrentDb.Execute stsql? I thought that code processing will not continue until this has been done or is this different than locking issue? You mentioned about slowing the do events, so perhaps this code is supposed to be used in another place in the loop, but in the loop we're using a recordset and table not running a query, so not sure how that works.

I've reworked my form to operate "backwards" -- counter is devised after selection rather than from the selection -- from how it was and tomorrow will try incorporating your code and suggestions. I'm also curious about your suggestion of the counter field being yes no rather than numeric and storing the counter number for each record. That may be an issue as they really like seeing the number col counting and resetting for each company when they export to excel, in case they do some further data filters down the road.

 

[vbaInet]

To answer your questions, I'm not sure how often this will be run overall, it will however be run multiple times a session in order to determine how many rows to select.

Is it just the one user that will run it or multiple users at the same time? If there are going to multiple users, have you thought about how you will handle this? Of course you can think of it at a much later stage.

Regarding query options I had looked at seeing if a query could do a running count grouped by company and also looked at TOP x.

100k isn't that much. Did you try a subquery - look for the section titled "TOP n records per group":
http://allenbrowne.com/subquery-01.html

Once you get the top n records per group, you can use another subquery (not a DCount() function) to create the counter.

The stillexecuting code is used only when resetting the counter, yes? If that is the case, would I need it if I'm using CurrentDb.Execute stsql? I thought that code processing will not continue until this has been done or is this different than locking issue? You mentioned about slowing the do events, so perhaps this code is supposed to be used in another place in the loop, but in the loop we're using a recordset and table not running a query, so not sure how that works.

Yes that's what StillExecuting is used for and nothing else. This code must complete before doing anything else because the rest of the code is totally reliant on the Counter. CurrentDb doesn't have a StillExecuting property so you need to use a QueryDef. Change the SQL property of a querydef and execute it as shown.

As for slowing DoEvents, I mentioned that as an aside, worry about this later.

 

[sxschech]

http://allenbrowne.com/subquery-01.html

was one of the sites I looked at, but didn't have much luck translating the example into the data I had. I tried again today and remembered that it took much longer to run than the recordset and I either got 1 record per company or all the records of the companies that matched the criteria so obviously I'm missing something in understanding. The data I'm working with doesn't have dates or common id to match on, just a unique id per record and looks like in the example, the id they are joining on is not unique. After playing around with that, didn't have time to work in the code for the MoveCounter, hopefully tomorrow or Thursday.

 

[vbaInet]

I either got 1 record per company or all the records of the companies that matched the criteria so obviously I'm missing something in understanding. The data I'm working with doesn't have dates or common id to match on, just a unique id per record and looks like in the example, the id they are joining on is not unique.

Yes there's something that you're missing. The Date field isn't necessary and the CustomerID field being joined against will be your CompanyID, and the OrderID field will be your ID field that uniquely identifies each record per company (for example you said "Company A may have 10 rows", so there must be an ID or perhaps an AutoID field that uniquely identifies each of the 10 records for CompanyA).

If you try something and can't make it work, post back what you've tried and we'll advise.

 

[sxschech]

Finally had time to devote to this and got it working. I ran into an error message while trying to implement vbaInet's approach on

.Execute dbFailOnError + dbRunAsync

and when I looked online (not thoroughly, I'll admit) seems that the sites I looked at indicated this was used for ODBC.

The solution I ended up with was actually one I had found before posting, but had missed a few lines of code. I needed to add code to close the recordset and set to nothing, also threw in a refreshcache just in case. The code now creates the recordset, loops through the records in 9,000 row increments, then closes, recreates the recordset and continues from the row position at the point when it hit an increment of 9000 then moves to the next row continuing until the next 90000 and so on until eof.

Note: Me.btnProcess.Caption is in there to give a visual of where the cursor is, but is not necessary for the code to run.

Top:
    Set rs = db.OpenRecordset(stsql)
    If Position > 1 Then rs.Move Position + 1
    With rs
        stCompany = rs!Company
        intCounter = 0
        Do While Not rs.EOF
            If stCompany = rs!Company Then
                intCounter = intCounter + 1
            Else
                intCounter = 1
            End If
            stCompany = rs!Company
            Position = .AbsolutePosition
            .Edit
            rs!COUNTER = intCounter
            .Update
            .MoveNext
                If (Position > 1) And (Position Mod 9000 = 0) Then
                    DoEvents
                    rs.Close
                    Set rs = Nothing
                    DBEngine.Idle dbRefreshCache
                    Me.btnProcess.Caption = "Now at row: " & Position & " of " & ttlrow '& " " & stCompany
                    GoTo Top
                End If
        Loop
    End With

Position code found at http://www.tek-tips.com/viewthread.cfm?qid=1007896

Side note: After reviewing vbaInet's recommended link, I was able to get the sql syntax to do a grouping query, but although it opens up fairly fast, trying to use it was too slow, navigation wise.

SELECT MyTable.company, MyTable.title, MyTable.lname, (Select Count(*) 
FROM tblBigList AS T Where t.company=MyTable.company and t.Custom_id <= MyTable.Custom_id) AS b
FROM tblBigList AS MyTable
WHERE (Select Count(*) 
FROM tblBigList AS T Where t.company=MyTable.company and t.Custom_id <= MyTable.Custom_id) <=val([cutoff]);