Exit Do --- Not Exiting

[leej1]

Hi
Having trouble with the following code. On the last record of the file I get an error, because the Exit Do statement doesn't seem to be working. Excuse the code it might not be the most effective way to write it, but the results are good.
Thanks

Dim db As Database
Dim rec As Recordset
Dim soc As String
Dim cnt As Integer
Dim times As Integer


Set db = CurrentDb()
Set rec = db.OpenRecordset("SELECT [Employee Table].[qsoc no],[Employee Table].[qgrouping]" & _
"FROM [Employee Table]" & _
"ORDER BY [Employee Table].[qsoc no]")

cnt = 1
times = 1
soc = " "


Do While Not rec.EOF

Do While times <= 30

' Exit if end of file
If rec.EOF = True Then
Exit Do
End If

' create groupings of 30 records
' if soc no the same as prior record keep in same group
rec.Edit
rec.Fields("qgrouping") = cnt
rec.Update
soc = rec.Fields("qsoc no")
times = times + 1
rec.MoveNext
If rec.Fields("qsoc no") = soc Then
times = times - 1
End If
Loop

' advance to new group of 30
cnt = cnt + 1
times = 1
Loop
rec.Close

 

[jadams0173]

how about.

for x = 1 to rec.recordcount
   do while x < 30
     your code
   loop

and maybe try this..

If rec.eof=true then
   rec.close
   exit sub
end if

 

[leej1]

Thank jadams0173 for the quick reply. Neither seems to work. I get a no currect record error on the instruction after the rec.movenext

 

[Crowley16]

your do while not rs.eof should quit automatically on the last record, so maybe you should have a look at the data you're actually getting back and seeing if there's something wrong there...

--------------------
Procrastinate Now!

 

[TheAceMan1]

How are ya leej1 . . .

A small critique on [blue]what your trying accomplish here[/blue] would help! I have an Idea, but? . . .

See Ya! . . . . . .

 

[leej1]

Thanks all for your replys. I am trying to create a grouping field for a report that must have 30 lines on each page. There can be more than 30 record because of duplicate soc no.
The data looks good, and the results of the codes creates the groups the way it should.
Thanks

 

[Crowley16]

have you tried

Do While Not rec.EOF

Do While times <= 30 AND Not rec.EOF

' Exit if end of file
If rec.EOF = True Then
Exit Do
End If
...
...

--------------------
Procrastinate Now!

 

[Remou]

You cannot MoveNext without check for an end of file after the move.

 

[TheAceMan1]

leej1 . . .

The grouping of [blue]30 lines per page[/blue] is easy to see in your code. Does not the following code . . .

[blue]Do While [purple][b]times[/b][/purple] <= 30
   [green]'Code[/green]
   [purple]times[/purple] = times + 1
   rec.MoveNext
   
   If rec.Fields("qsoc no") = soc Then
     [purple][b][u]times = times - 1[/u][/b][/purple]
   End If[/blue]

. . . [blue]allow for conditions of more than 30?[/blue]
Resolve this and I can clean the code . . .

See Ya! . . . . . .

 

[Craig0201]

Dim db As Database
Dim rec As Recordset
Dim soc As String
Dim cnt As Integer
Dim times As Integer


Set db = CurrentDb()
Set rec = db.OpenRecordset("SELECT [Employee Table].[qsoc no],[Employee Table].[qgrouping]" & _
"FROM [Employee Table]" & _
"ORDER BY [Employee Table].[qsoc no]")

cnt = 1
times = 1
soc = " "


Do While Not rec.EOF
Do While times <= 30
' Exit if end of file
If rec.EOF = False Then



' create groupings of 30 records
' if soc no the same as prior record keep in same group
rec.Edit
rec.Fields("qgrouping") = cnt
rec.Update
soc = rec.Fields("qsoc no")
times = times + 1
rec.MoveNext
If rec.Fields("qsoc no") = soc Then
times = times - 1
End If
Else
times = 31
End If
Loop

' advance to new group of 30
cnt = cnt + 1
times = 1
Loop
rec.Close

 

[Remou]

[tt]rec.MoveNext
If rec.Fields("qsoc no") = soc Then
times = times - 1
End If[/tt]
You are still moving next without checking for end of file.

 

[leej1]

Thanks again for all your help.
It seems to me that the file is advancing past the last record, because the instruction
If rec.Fields("qsoc no") = soc Then
is the line that gives me the error (No Current Record).
I used your code and the error came up at the same line of code
Thanks for all your time and effort.

 

[jadams0173]

I think what Remou is saying is you need to add a check for EOF.

rec.MoveNext
[b]If rec.EOF then exit sub[/b]
if rec.Fields("qsoc no")=soc then
 
keep going with your code.

 

[TheAceMan1]

leej1 . . .

I was finally able to get back to this. The following method involves [blue]a function and an Update SQL[/blue] statement.

In a [blue]module[/blue] in the [blue]modules[/blue] window, copy/paste the following function (the function [blue]returns the proper index value for qgrouping[/blue]):

[blue]Public Function [purple][b]GrpIdx([/b][/purple]QSOC[purple][b])[/b][/purple]
   Dim db As DAO.Database, rst As DAO.Recordset, SQL As String
   
   Set db = CurrentDb
   SQL = "SELECT [qsoc no], qgrouping " & _
         "FROM [Employee Table] " & _
         "ORDER BY [qsoc no];"
   Set rst = db.OpenRecordset(SQL, dbOpenDynaset)
   
   rst.FindFirst "[qsoc no] = " & QSOC
   [purple][b]GrpIdx[/b][/purple] = [purple]Int((rst.AbsolutePosition - 1) / 30)[/purple]
   
   Set rst = Nothing
   Set db = Nothing
   
End Function[/blue]

Then run the following code from anywhere you like to update:

[blue]   Dim SQL As String

   SQL = "UPDATE [Employee Table] " & _
         "SET qgrouping = [purple][b]GrpIdx([/b][/purple][qsoc no][purple][b])[/b][/purple];"
   DoCmd.RunSQL SQL[/blue]

[blue]Thats it! . . .[/blue]

See Ya! . . . . . .