0
votes

I am trying to run this bit of code through a button, this is my first time using VBA, and I am not sure why I am getting this error:

Run-time error '3021': No current record.

On this line of the code:

ConsumerID_1 = rs!CONSUMER_ID

The recordset has 26k records, the first time I clicked the button it worked but on re-clicking the error appears.

Here is my code:

Private Sub Command23_Click()

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tbl_30days_NoDefaults", dbOpenDynaset)

'1. Start of recordset
'2. Store 1st Consumer ID (v1)
'3. Move to next record
'4. Store 2nd Consumer ID (v2)
'5. Compare both Consumer IDs for a match
'6. If matched Then move to previous record and store repair date (v3), go 
to 8.
'   7. Else Move to next record and loop back to 2.
'8. Move to next record and store call date (v4)
'9. Compare repair date and call date and find the difference between them 
to check If they are within 30 days of each other
'10. If <30 days, move to previous record and check Repeat field boolean 
True/Yes
'11. Move to next record and loop back to 2.

Dim ConsumerID_1 As Long
Dim ConsumerID_2 As Long
Dim RepairDate As Date
Dim CallDate As Date
Dim DiffDate As Long

rs.MoveFirst

Do Until rs.EOF

FirstLoop:
ConsumerID_1 = rs!CONSUMER_ID
rs.MoveNext
ConsumerID_2 = rs!CONSUMER_ID
If ConsumerID_1 = ConsumerID_2 Then
    rs.MovePrevious
    RepairDate = rs!RepairDate
    rs.MoveNext
    CallDate = rs!CsrCallDate
    DiffDate = DateDiff("d", RepairDate, CallDate)
        If DiffDate <= 30 Then
            rs.MovePrevious
            rs.Edit
            rs!RepeatBoolean = True
            rs.Update
            rs.MoveNext
            GoTo FirstLoop
        Else
            rs.MovePrevious
            rs.Edit
            rs!RepeatBoolean = False
            rs.Update
            rs.MoveNext
            GoTo FirstLoop
        End If
Else
    rs.MoveNext
    GoTo FirstLoop
End If

Loop

rs.Close

End Sub

Is it because I have not cleared the variables or am I using the wrong type of loop?

EDIT #1

Snapshot of table in current form and Snapshot of table in current form

Some of the records have been successfully captured while others have been missed out completely.

I will clarify further, I was initially given a data dump, with all records in no particular order. I used a select query and make table query to get this data into a more understandable recordset. The relevant fields are CSR (which is unique with no duplicates), CONSUMER_ID (which is unique to each consumer however there are duplicates since one consumer can have multiple call outs), CsrModel, CsrSerialNumber, CsrCallDate, RepairDate and RepeatBoolean.

I have been told to group the records by three fields: CONSUMER_ID, CsrModel, and CsrSerialNumber. So when you pull up the table, for example, a CONSUMER_ID may be present 3 times along with matching identical CsrModel numbers and CsrSerialNumber. The CSR field for each consumer is in ascending order so that both the CsrCallDate and RepairDate are also in order from old to new. My objective is to loop through each record and check whether the CONSUMER_ID's match first and then if so execute the code to check if the 30 day criteria is met.

My problem at the moment, after testing the code several times, is that it will not capture all the required records, it misses out some for reasons I'm not full comprehending. If I use two recordsets will this solve the issue?

The following is the SQL from the query that made the above table:

SELECT tbl_30days_CSR.CONSUMER_ID, tbl_30days_CSR.CSR, 
tbl_30days_CSR.CsrCallDate, tbl_30days_CSR.RepairDate, 
tbl_30days_CSR.CsrModel, tbl_30days_CSR.CsrSerialNumber
FROM tbl_30days_CSR
GROUP BY tbl_30days_CSR.CONSUMER_ID, tbl_30days_CSR.CSR, 
tbl_30days_CSR.CsrCallDate, tbl_30days_CSR.RepairDate, 
tbl_30days_CSR.CsrModel, tbl_30days_CSR.CsrSerialNumber
HAVING (((tbl_30days_CSR.CONSUMER_ID) In (SELECT [CONSUMER_ID] FROM 
[tbl_30days_CSR] As Tmp GROUP BY [CONSUMER_ID] HAVING Count(*)>1 )) AND 
((tbl_30days_CSR.CsrModel) In (SELECT [CsrModel] FROM [tbl_30days_CSR] As 
Tmp GROUP BY [CsrModel] HAVING Count(*)>1 )) AND 
((tbl_30days_CSR.CsrSerialNumber) In (SELECT [CsrSerialNumber] FROM 
[tbl_30days_CSR] As Tmp GROUP BY [CsrSerialNumber] HAVING Count(*)>1 ) And 
(tbl_30days_CSR.CsrSerialNumber)<>565432105 And 
(tbl_30days_CSR.CsrSerialNumber)<>1));

Edit #2

Current code using Jericho's solution, however still not capturing everything:

Private Sub Command26_Click()

'Dim db As DAO.Database
Dim rstConsumers As DAO.Recordset
Dim rstCalls As DAO.Recordset
Dim mssql As String
Dim RepairDate As Date

'Set db = CurrentDb()
' ==============================
' Get a unique list of Consumer_ID's into a RecordSet
' ==============================
mssql = "SELECT tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID FROM 
tbl_30days_CSR_NoDefaultsOr1s_v2 GROUP BY CONSUMER_ID;"
Set rstConsumers = CurrentDb.OpenRecordset(mssql, dbOpenSnapshot)
Do While Not rstConsumers.EOF
' ==============================
' For each unique Consumer_ID, get the list of Calls in date order
' ==============================
mssql = "SELECT * FROM tbl_30days_CSR_NoDefaultsOr1s_v2 WHERE 
tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID = " & rstConsumers("CONSUMER_ID")
mssql = mssql & " ORDER BY tbl_30days_CSR_NoDefaultsOr1s_v2.CSR;"
Set rstCalls = CurrentDb.OpenRecordset(mssql, dbOpenDynaset)
Do While Not rstCalls.EOF
    RepairDate = rstCalls("RepairDate")
    rstCalls.MoveNext
    If Not rstCalls.EOF Then
        If DateDiff("d", RepairDate, rstCalls("CsrCallDate")) <= 30 And 
        DateDiff("d", RepairDate, rstCalls("CsrCallDate")) >= -30 And 
        DateDiff("d", RepairDate, rstCalls("CsrCallDate")) = 0 Then
            rstCalls.MovePrevious
            rstCalls.Edit
            rstCalls("RepeatBoolean") = True
            rstCalls.Update
        'Else  NOT REQUIRED SINCE DEFUALT IS UNCHECKED (FALSE)
            'rstCalls.MovePrevious
            'rstCalls.Edit
            'rstCalls("RepeatBoolean") = False
            'rstCalls.Update
        End If
        rstCalls.MoveNext
    End If
Loop
' ==============================
' After we have processed all of the Calls for this Consumer_ID
' Close the RecordSet for these Calls and loop to the next Consumer_ID
' ==============================
rstCalls.Close
rstConsumers.MoveNext
Loop

MsgBox "Finished looping through records."

rstConsumers.Close
'Set db = Nothing
'db.Close

End Sub

Edit #3

Updated code

Final Edit #4

Private Sub Command26_Click()

'Dim db As DAO.Database
Dim rstConsumers As DAO.Recordset
Dim rstCalls As DAO.Recordset
Dim mssql As String
Dim RepairDate As Date

'Set db = CurrentDb()
' ==============================
' Get a unique list of Consumer_ID's into a RecordSet
' ==============================
mssql = "SELECT tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID FROM 
tbl_30days_CSR_NoDefaultsOr1s_v2 GROUP BY CONSUMER_ID;"
Set rstConsumers = CurrentDb.OpenRecordset(mssql, dbOpenSnapshot)
Do While Not rstConsumers.EOF
' ==============================
' For each unique Consumer_ID, get the list of Calls in date order
' ==============================
mssql = "SELECT * FROM tbl_30days_CSR_NoDefaultsOr1s_v2 WHERE 
tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID = " & 
rstConsumers("CONSUMER_ID")
mssql = mssql & " ORDER BY tbl_30days_CSR_NoDefaultsOr1s_v2.CSR;"
Set rstCalls = CurrentDb.OpenRecordset(mssql, dbOpenDynaset)
Do While Not rstCalls.EOF
    RepairDate = rstCalls("RepairDate")
    rstCalls.MoveNext
    If Not rstCalls.EOF Then
        If DateDiff("d", RepairDate, rstCalls("CsrCallDate")) <= 30 And 
           DateDiff("d", RepairDate, rstCalls("CsrCallDate")) >= -30 Then
            rstCalls.MovePrevious
            rstCalls.Edit
            rstCalls("RepeatBoolean") = True
            rstCalls.Update
            rstCalls.MoveNext   'MOVED HERE***
        'Else   NOT REQUIRED SINCE DEFUALT IS UNCHECKED (FALSE)
            'rstCalls.MovePrevious
            'rstCalls.Edit
            'rstCalls("RepeatBoolean") = False
            'rstCalls.Update
        End If
        rstCalls.MoveNext 'MOVED INSIDE THE IF STATEMENT***
    End If
Loop
' ==============================
' After we have processed all of the Calls for this Consumer_ID
' Close the RecordSet for these Calls and loop to the next Consumer_ID
' ==============================
rstCalls.Close
rstConsumers.MoveNext
Loop

MsgBox "Finished looping through records."

rstConsumers.Close
'Set db = Nothing
'db.Close

End Sub
1
What line in the code throws this error? Note: You can use debug to step through the code line by line. - MiguelH
before movefirst, check if you actually have any record in the recordset. - cyboashu
It's this line: ConsumerID_1 = rs!CONSUMER_ID. The recordset has 26k records. It ran once when I clicked the button but when I try again the error appears - Env67
I have edited the original post with further details - Env67
I have a feeling it is starting at the end of the recordset for some reason, the ConsumerID_1 variable holds the last ID number from the recordset when it throws the error - Env67

1 Answers

2
votes

While there may be a different way to achieve your intended results, the crux of the problem with your current code is that by using the GoTo FirstLoop commands, you are bypassing the EOF checking that the Do Until rs.EOF line is supposed to perform. Therefore, your code IS actually looping through all the records, and one of your rs.MoveNext lines is causing the Recordset to get to EOF, and your GoTo FirstLoop takes you directly to a line of code trying to retrieve a value that does not exist, therefore the error is generated.

Your Do loop is a loop, and there is no need to artificially force looping with your GoTo statements.

I have modified your loop to allow the EOF checking to do it's job and exit the loop when you run out of records.

I would expect your original code to run differently based on there being an odd or even number of records in your RecordSet. But I also think your original code would have been an infinite loop until the error occurs because I see no way for your original code to exit the loop. All three execution paths (your various If Then Else statements) contain a GoTo FirstLoop, so it appears your code could only have ended in an error when EOF was finally reached.

' ==============================
' The original rs.MoveFirst line is not needed before the loop
' and would actually generate an error if there
' happened to be zero (0) records returned in the RecordSet
' ==============================

Do While Not rs.EOF
    ConsumerID_1 = rs!CONSUMER_ID
    rs.MoveNext
    ' ==============================
    ' Always check for EOF after a MoveNext
    ' before retrieving a value
    ' ==============================
    If Not rs.EOF Then
        ConsumerID_2 = rs!CONSUMER_ID

        If ConsumerID_1 = ConsumerID_2 Then
            rs.MovePrevious
            RepairDate = rs!RepairDate
            rs.MoveNext
            ' ==============================
            ' Since we have already performed a MoveNext
            ' and MovePrevious, we know these two records
            ' exist and it is safe to exclude the EOF check
            ' ==============================
            CallDate = rs!CsrCallDate
            DiffDate = DateDiff("d", RepairDate, CallDate)
            If DiffDate <= 30 Then
                rs.MovePrevious
                rs.Edit
                rs!RepeatBoolean = True
                rs.Update
            Else
                rs.MovePrevious
                rs.Edit
                rs!RepeatBoolean = False
                rs.Update
            End If
        End If
        rs.MoveNext
    End If
Loop
rs.Close

I have also removed some of your redundant rs.MoveNext commands and consolidated them into a single line that all three cases that existed before will still execute.

This code will perform the same actions you had in the original code, and it will not error out when there are odd numbers of records in your table.

Update #1

Based on additional questions in the comments by the OP, the following code should provide the intended results.

Dim db As DAO.Database
Dim rstConsumers As DAO.Recordset
Dim rstCalls As DAO.Recordset
Dim mssql As String
Dim RepairDate As Date

Set db = CurrentDb()
' ==============================
' Get a unique list of Consumer_ID's into a RecordSet
' ==============================
mssql = "SELECT CONSUMER_ID FROM tbl_30days_NoDefaults GROUP BY CONSUMER_ID;"
Set rstConsumers = db.OpenRecordset(mssql, dbOpenSnapshot)
Do While Not rstConsumers.EOF
    ' ==============================
    ' For each unique Consumer_ID, get the list of Calls in date order
    ' ==============================
    mssql = "SELECT * FROM tbl_30days_NoDefaults WHERE CONSUMER_ID = " & rstConsumers("CONSUMER_ID")
    mssql = mssql & " ORDER BY CsrCallDate;"
    Set rstCalls = db.OpenRecordset(mssql, dbOpenDynaset)
    Do While Not rstCalls.EOF
        RepairDate = rstCalls("RepairDate")
        rstCalls.MoveNext
        If Not rstCalls.EOF Then
            If DateDiff("d", RepairDate, rstCalls("CsrCallDate")) <= 30 Then
                rstCalls.MovePrevious
                rstCalls.Edit
                rstCalls("RepeatBoolean") = True
                rstCalls.Update
            Else
                rstCalls.MovePrevious
                rstCalls.Edit
                rstCalls("RepeatBoolean") = False
                rstCalls.Update
            End If
            rstCalls.MoveNext
        End If
    Loop
    ' ==============================
    ' After we have processed all of the Calls for this Consumer_ID
    ' Close the RecordSet for these Calls and loop to the next Consumer_ID
    ' ==============================
    rstCalls.Close
    rstConsumers.MoveNext
Loop
rstConsumers.Close
Set db = Nothing
db.Close