No current record

[khwaja]

I am trying to use the following code to report two values into one line.It works fine except for the fact that when it writes the last record, it errors out with 'No current record' error. Could someone help me amend the code to prevent this error from happening.

Public Sub combine_descriptions()
'turn off warning dialog
DoCmd.SetWarnings (False)


Dim rst As Recordset
Dim strCurrentCustomer As String

Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl ORDER BY Customer")
strCurrentCustomer = vbNullString

'set comments back to null
strcomments = vbNullString

Do

Do
strcomments = strcomments & " " & Nz(rst!comments, vbNullString)
strCurrentCustomer = rst!customer

'move to next record
rst.Move 1

Loop Until rst!customer <> strCurrentCustomer

DoCmd.RunSQL "INSERT INTO newtablename ( Customer, Comments ) SELECT '" & strCurrentCustomer & "','" & strcomments & "'"

'reset comments
strcomments = vbNullString

Loop Until rst.EOF

rst.Close
Set rst = Nothing

'turn dialogs back on
DoCmd.SetWarnings (True)


End Sub

 

[MarkK]

See if this makes a difference. You weren't checking for .eof at the end of your nested loop ...

Public Sub combine_descriptions()
   Dim rst As Recordset
   Dim strCustomer As String
   Dim strComments As String
   
   Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl ORDER BY Customer")
   
   With rst
      Do
         'set customer and reset comments
         strCustomer = !customer
         strComments = ""
         
         Do
            'accumulate comments
            strComments = strComments & " " & Nz(!Comments, vbNullString)
            .MoveNext
         Loop Until .EOF Or !customer <> strCustomer
         
         CurrentDb.Execute "INSERT INTO newtablename ( Customer, Comments ) SELECT '" & strCustomer & "','" & strComments & "'"
      Loop Until .EOF
      .Close
   End With
   Set rst = Nothing

End Sub

 

[khwaja]

Many thanks. After posting my question, I continued to work on changing the code to suit my situation. To test your code, I carefully amended it to reflect the changes I had. I have reproduced the current code below for your ref. This still works but I still have a runtime error 3021 'no current record'.

Public Sub combine_descriptions()
Dim rst As Recordset
Dim strLocNo As Integer
Dim strLocation As String
Dim strProject As String


DoCmd.RunSQL "Delete *from [tblCombProjects];"

Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblSIBProjects Order BY Location")

With rst
Do
'set location and reset project
strLocation = !Location
strProject = ""

Do
'accumulate Project
strProject = strProject & " " & Nz(!Project, vbNullString)
.MoveNext
Loop Until .EOF Or !Location <> strLocation

CurrentDb.Execute "INSERT INTO tblCombProjects( LocNo, Location, Project ) SELECT '" & strLocNo & " ', '" & strLocation & "','" & strProject & "'"
Loop Until .EOF
.Close
End With
Set rst = Nothing

End Sub

 

[MarkK]

What line of code causes the error?
Also, if you post code, see the # character above this text window? Highlight all your code and hit that button, which preserves your indents and makes it way easier to read.

 

[khwaja]

There is no particular line causing the error. It is the same error I was getting after running the code. What i am saying that even after taking the changes you made I still have the same error right at the end of routine.

Public Sub combine_descriptions()
'turn off warning dialog
DoCmd.SetWarnings (False)


Dim rst As Recordset
Dim strLocNo As Integer
Dim strCurrentLocation As String
Dim strProject As String

Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblSIBProjects ORDER BY Location")
strCurrentLocation = vbNullString

'set projects back to null
strProject = vbNullString

DoCmd.RunSQL "Delete *from [tblCombProjects];"
Do

Do
strLocNo = rst!LocNo
strProject = strProject & " " & Nz(rst!Project, vbNullString)
strCurrentLocation = rst!Location


'move to next record
rst.Move 1

Loop Until rst!Location <> strCurrentLocation


DoCmd.RunSQL "INSERT INTO tblCombProjects( Locno, Location, Project ) SELECT '" & strLocNo & " ','  " & strCurrentLocation & " ','" & strProject & "'"

'reset Project
strProject = vbNullString

Loop Until rst.EOF

rst.Close
Set rst = Nothing

'turn dialogs back on
DoCmd.SetWarnings (True)


End Sub

 

[spikepl]

You are stepping beyond EOF. You need to carefully rethink your logic and test whether or not rst.EOF where appropriate

Note that a test like

Loop Until .EOF Or !Location <> strLocation

may fail, because in Access the right-side of the OR still gets evaluated even if the left-hand condition is true (ie. you are at EOF), but the !Location is unavailable at EOF.

 

[khwaja]

Thanks. Looks like the code I reproduced was not correct. Please could you the following and see if you can amend it.

Public Sub combine_descriptions()
Dim rst As Recordset
Dim strLocNo As Integer
Dim strLocation As String
Dim strProject As String


DoCmd.RunSQL "Delete *from [tblCombProjects];"

Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblSIBProjects Order BY Location")

With rst
Do
'set location and reset project
strLocation = !Location
strProject = ""

Do
'accumulate Project
strProject = strProject & " " & Nz(!Project, vbNullString)
.MoveNext
Loop Until .EOF Or !Location <> strLocation

CurrentDb.Execute "INSERT INTO tblCombProjects( LocNo, Location, Project ) SELECT '" & strLocNo & " ', '" & strLocation & "','" & strProject & "'"
Loop Until .EOF
.Close
End With
Set rst = Nothing

End Sub