Recordset Source in VB

I am opening a recordset in Visual Basic with my source as an SQL statement
and the result is empty, yet when I run a query outside the code records are
returned. I also used the query as the source in VB and the recordset is
still empty. Can anyone explain why there is the inconsistency and what I can
do differently to get accurate results? I am working with Access 2000.
Thanks in advance for any assistance.

On Tue, 11 Jan 2005 10:33:04 -0800, str8trini
wrote:

I am opening a recordset in Visual Basic with my source as an SQL statement
and the result is empty, yet when I run a query outside the code records are
returned. I also used the query as the source in VB and the recordset is
still empty. Can anyone explain why there is the inconsistency and what I can
do differently to get accurate results? I am working with Access 2000.
Thanks in advance for any assistance.

let me guess a little bit:

it's a linked table from another none-Jet-Database?
......
......
......
maybe others can guess also?
or
maybe you give as more information?????

---
If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW

Huh??? Are you being serious, because if you are I am not sure what more
information you are asking for. I am linked to a backend, but as far as I
know it is a Jet DB. Maybe I am not as advanced as you are and maybe a
little ignorant in knowing what to ask for and what information I need to
supply. Anyway thanks for taking the time to try to help.

"Andi Mayer" wrote:

On Tue, 11 Jan 2005 10:33:04 -0800, str8trini
wrote:

I am opening a recordset in Visual Basic with my source as an SQL statement
and the result is empty, yet when I run a query outside the code records are
returned. I also used the query as the source in VB and the recordset is
still empty. Can anyone explain why there is the inconsistency and what I can
do differently to get accurate results? I am working with Access 2000.
Thanks in advance for any assistance.

let me guess a little bit:

it's a linked table from another none-Jet-Database?
......
......
......
maybe others can guess also?
or
maybe you give as more information?????

---
If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW

The code that builds the SQL statement and opens the recordset would be a
good start.

--
Brendan Reynolds (MVP)
http://brenreyn.blogspot.com

The spammers and script-kiddies have succeeded in making it impossible for
me to use a real e-mail address in public newsgroups. E-mail replies to
this post will be deleted without being read. Any e-mail claiming to be
from brenreyn at indigo dot ie that is not digitally signed by me with a
GlobalSign digital certificate is a forgery and should be deleted without
being read. Follow-up questions should in general be posted to the
newsgroup, but if you have a good reason to send me e-mail, you'll find
a useable e-mail address at the URL above.


"str8trini" wrote in message
...
Huh??? Are you being serious, because if you are I am not sure what more
information you are asking for. I am linked to a backend, but as far as I
know it is a Jet DB. Maybe I am not as advanced as you are and maybe a
little ignorant in knowing what to ask for and what information I need to
supply. Anyway thanks for taking the time to try to help.

"Andi Mayer" wrote:

On Tue, 11 Jan 2005 10:33:04 -0800, str8trini
wrote:

I am opening a recordset in Visual Basic with my source as an SQL
statement
and the result is empty, yet when I run a query outside the code records
are
returned. I also used the query as the source in VB and the recordset is
still empty. Can anyone explain why there is the inconsistency and what
I can
do differently to get accurate results? I am working with Access 2000.
Thanks in advance for any assistance.

let me guess a little bit:

it's a linked table from another none-Jet-Database?
......
......
......
maybe others can guess also?
or
maybe you give as more information?????

---
If you expect an answer to a personal mail, add the word "manfred" to the
first 10 lines in the message
MW

On Tue, 11 Jan 2005 11:03:02 -0800, str8trini
wrote:

Huh??? Are you being serious, because if you are I am not sure what more
information you are asking for. I am linked to a backend, but as far as I
know it is a Jet DB. Maybe I am not as advanced as you are and maybe a
little ignorant in knowing what to ask for and what information I need to
supply. Anyway thanks for taking the time to try to help.

I am serious, but I still see no SQL-string, ADO or DAO
information,....

What you mean with " outside the code"?


If you link with SQLBase, Universe,... you can have a lot of different
slangs, which don't work in Access (syntax is OK, but the result vary)
---
If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW

This is probably more than you need but I am referring to my .Source for the
recordset. rs.EOF is true when stepping through the code. By Outside the
code I mean just opening the query from the DB window. My result from that is
8 records.


Public Sub WaitListUpdate()
'This procedure considers the ELF when updating from the WL
'and updates from the WL only when the requested shift does not
'exceed the threshold. It will override a person higher on the
'waitlist if the requested shift will put it over the limit.

On Error GoTo Err_cmdWaitList_Click
Dim cn As ADODB.Connection, rs As ADODB.Recordset, rsTeam As ADODB.Recordset
Dim x As Integer, AvailDate As Date, Slots As Integer, WL_Count As Integer,
strAM As String, strLP As String
Dim dteAvailDateAM() As Date, a As Integer, dteAvailDateLP() As Date, L As
Integer, dteWL_Date As Date
Dim lngID() As Long, lngRecID As Long, i As Integer, GrpAvail As Double,
intCount As Integer
Dim intE As Integer, intL As Integer, intF As Integer, Max As Integer,
intTeam As Long, ReturnValue As Variant

strAM = "Account Maintenance"
strLP = "Loss Prevention"

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rsTeam = New ADODB.Recordset


With rs
Set .ActiveConnection = cn
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
End With

With rsTeam
Set .ActiveConnection = cn
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
End With

DoCmd.SetWarnings False
DoCmd.OpenQuery "qryDelExpired"

ReDim lngID(0)
i = 1
ReDim dteAvailDateAM(0)
a = 1
ReDim dteAvailDateLP(0)
L = 1

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select DISTINCT Count(EligibleDates) AS RecCount FROM
qryTimeOffAvailSummAM WHERE [WL] 0 AND [Avail] 0"
.Open
End With

intCount = rs!RecCount

'Initialize progress meter.
ReturnValue = SysCmd(acSysCmdInitMeter, "Checking for WaitList
Updates-Account Maintenance", intCount)

AM:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select DISTINCT EligibleDates AS WL_Date FROM
qryTimeOffAvailSummAM WHERE [WL] 0 AND [Avail] 0"
.Open
End With

If rs.EOF Then
GoTo LP
End If


"Andi Mayer" wrote:

On Tue, 11 Jan 2005 11:03:02 -0800, str8trini
wrote:

Huh??? Are you being serious, because if you are I am not sure what more
information you are asking for. I am linked to a backend, but as far as I
know it is a Jet DB. Maybe I am not as advanced as you are and maybe a
little ignorant in knowing what to ask for and what information I need to
supply. Anyway thanks for taking the time to try to help.

I am serious, but I still see no SQL-string, ADO or DAO
information,....

What you mean with " outside the code"?


If you link with SQLBase, Universe,... you can have a lot of different
slangs, which don't work in Access (syntax is OK, but the result vary)
---
If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW

On Tue, 11 Jan 2005 11:51:06 -0800, str8trini
wrote:

I hope Brendan steps in, because I am a DAO-orientated

but my expirence with ADO showed me:
you don't get a recordcount with ADO

therefore it everytime -1 (unknown)

Have you tried to walk through the rs?
While not rs.eof
debug.print rs.fields(0)
rs.movenext
wend


---
If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW

I'm finding the code very difficult to read, and I think it is not complete.
One thing that stands out, though, is that the original poster said that the
query returns eight records, but the source of the recordset is not the
query, but a SQL statement that selects from the query - how many of those
eight records meet the criteria of the SQL statement, i.e. [WL] 0 and
[Avail] 0?

--
Brendan Reynolds (MVP)
http://brenreyn.blogspot.com

The spammers and script-kiddies have succeeded in making it impossible for
me to use a real e-mail address in public newsgroups. E-mail replies to
this post will be deleted without being read. Any e-mail claiming to be
from brenreyn at indigo dot ie that is not digitally signed by me with a
GlobalSign digital certificate is a forgery and should be deleted without
being read. Follow-up questions should in general be posted to the
newsgroup, but if you have a good reason to send me e-mail, you'll find
a useable e-mail address at the URL above.


"Andi Mayer" wrote in message
...
On Tue, 11 Jan 2005 11:51:06 -0800, str8trini
wrote:

I hope Brendan steps in, because I am a DAO-orientated

but my expirence with ADO showed me:
you don't get a recordcount with ADO

therefore it everytime -1 (unknown)

Have you tried to walk through the rs?
While not rs.eof
debug.print rs.fields(0)
rs.movenext
wend


---
If you expect an answer to a personal mail, add the word "manfred" to the
first 10 lines in the message
MW

I didn't think you would want the complete code so I just sent up to the part
where I was getting the error. You are correct the source of the recordset
was an SQL statement that selected from the query. I have since created the
query to match exactly to my recordset. I still get the same result though.
I added a line of code to open the query and the result is the eight records.
However, rs.EOF is still true when the results should match that of the
openquery command. The complete revised code is attached. Please keep in
mind that I am an amateur at this and it was self taught so it may not appear
to be very professionally written. Thanks!

'This procedure considers the ELF when updating from the WL
'and updates from the WL only when the requested shift does not
'exceed the threshold. It will override a person higher on the
'waitlist if the requested shift will put it over the limit.

On Error GoTo Err_cmdWaitList_Click
Dim cn As ADODB.Connection, rs As ADODB.Recordset, rsTeam As ADODB.Recordset
Dim x As Integer, AvailDate As Date, Slots As Integer, WL_Count As Integer,
strAM As String, strLP As String
Dim dteAvailDateAM() As Date, a As Integer, dteAvailDateLP() As Date, L As
Integer, dteWL_Date As Date
Dim lngID() As Long, lngRecID As Long, i As Integer, GrpAvail As Double,
intCount As Integer
Dim intE As Integer, intL As Integer, intF As Integer, Max As Integer,
intTeam As Long, ReturnValue As Variant

strAM = "Account Maintenance"
strLP = "Loss Prevention"

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rsTeam = New ADODB.Recordset


With rs
Set .ActiveConnection = cn
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
End With

With rsTeam
Set .ActiveConnection = cn
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
End With

DoCmd.SetWarnings False
DoCmd.OpenQuery "qryDelExpired"

ReDim lngID(0)
i = 1
ReDim dteAvailDateAM(0)
a = 1
ReDim dteAvailDateLP(0)
L = 1

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select Count(EligibleDates) AS RecCount FROM
sqlAvailSummAM"
.Open
End With

intCount = rs!RecCount

'Initialize progress meter.
ReturnValue = SysCmd(acSysCmdInitMeter, "Checking for WaitList
Updates-Account Maintenance", intCount)

AM:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "sqlAvailSummAM"
.Open
End With
DoCmd.OpenQuery "sqlAvailSummAM"

If rs.EOF Then
GoTo LP
End If

Do Until rs.EOF
ReDim Preserve dteAvailDateAM(a)
dteAvailDateAM(a) = rs!WL_Date
a = a + 1
rs.MoveNext
Loop

For a = 1 To UBound(dteAvailDateAM)
ReturnValue = SysCmd(acSysCmdUpdateMeter, a)
dteWL_Date = dteAvailDateAM(a)
'AM Specialty
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct,
GroupThreshold, Avail FROM qryTimeOffAvailSummAM WHERE Avail 0 AND WL 0 AND
Specialty = -1 AND EligibleDates = #" & dteWL_Date & "#"
.Open
End With

If rs.EOF Then
GoTo AM_NonSpec
End If

Slots = CLng(rs!Avail + 0.1)
intE = rs!E_Ct
intL = rs!L_Ct
intF = rs!F_Ct
Max = rs!GroupThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitList WHERE DeptName = '" & strAM & "'" & " and Specialty = -1 and
DateBegin = #" & dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If

ElseIf rs!AmountOff = "L" And (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And ((Max - (intF + intE)) = 1 And (Max -
(intF + intL)) = 1) Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x

'AM Non Specialty
AM_NonSpec:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct,
GroupThreshold, Avail FROM qryTimeOffAvailSummAM WHERE [Avail] 0 AND WL 0
AND Specialty = 0 AND EligibleDates = #" & dteWL_Date & "#"
.Open
End With

Slots = CLng(rs!Avail + 0.1)
intE = rs!E_Ct
intL = rs!L_Ct
intF = rs!F_Ct
Max = rs!GroupThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitList WHERE DeptName = '" & strAM & "'" & " and Specialty = 0 and
DateBegin = #" & dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And ((Max - (intF + intE)) = 1 And (Max -
(intF + intL)) = 1) Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
Next a

LP:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select DISTINCT Count(EligibleDates) AS RecCount FROM
qryTimeOffAvailGroupLP"
.Open
End With

intCount = rs!RecCount
'Reset status text
ReturnValue = SysCmd(acSysCmdClearStatus)
'Initialize progress meter.
ReturnValue = SysCmd(acSysCmdInitMeter, "Checking for WaitList Updates-Loss
Prevention", intCount)

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select DISTINCT EligibleDates AS WL_Date FROM
qryTimeOffAvailGroupLP"
.Open
End With

If rs.EOF Then
GoTo Fini****
End If

Do Until rs.EOF
ReDim Preserve dteAvailDateLP(L)
dteAvailDateLP(L) = rs!WL_Date
L = L + 1
rs.MoveNext
Loop

For L = 1 To UBound(dteAvailDateLP)
dteWL_Date = dteAvailDateLP(L)
ReturnValue = SysCmd(acSysCmdUpdateMeter, L)
'LP Specialty
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, SumOfE_Ct As E_Ct, SumOfL_Ct
As L_Ct, SumOfF_Ct As F_Ct, GroupThreshold, GroupAvail FROM
qryTimeOffAvailGroupLP_Spec WHERE EligibleDates = #" & dteWL_Date & "#"
.Open
End With

If rsTeam.EOF Then
GoTo LP1
End If

Slots = CLng(rsTeam!GroupAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!GroupThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitList WHERE DeptName = '" & strLP & "'" & " AND Specialty = -1 AND
DateBegin = #" & dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If

ElseIf rs!AmountOff = "L" And (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And ((Max - (intF + intE)) = 1 And (Max -
(intF + intL)) = 1) Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x

'LP Non-Specialty
LP1:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP1' AND EligibleDates = #" & dteWL_Date &
"#"
.Open
End With

If rsTeam.EOF Then
GoTo LP2
End If

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop

LP2:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP2' AND EligibleDates = #" & dteWL_Date &
"#"
.Open
End With

If rsTeam.EOF Then
GoTo LP3
End If

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop

LP3:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP3' AND EligibleDates = #" & dteWL_Date &
"#"
.Open
End With

If rsTeam.EOF Then
GoTo LP4
End If

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop

LP4:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP4' AND EligibleDates = #" & dteWL_Date &
"#"
.Open
End With

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop
Next L

Fini****:
For i = 1 To UBound(lngID)
lngRecID = lngID(i)

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select TO_ID, Reason, Approved, UpdateTime, UpdateUser
FROM tblTimeOff WHERE TO_ID = " & lngRecID & ""
.Open
End With

rs!Reason = 5
rs!Approved = -1
rs!UpdateTime = Now()
rs!UpdateUser = CurrentUser()
rs.Update

Next i

Dim strOutputFormat As String, strName As String, strPath As String
strOutputFormat = "Snapshot Format"
strName = "rptWaitListUpdates"
'strPath = "C:\Attendance\rptWaitListUpdates.snp"
strPath = "W:\SchdAttn\Data\WaitListUpdates.snp"

MsgBox "Wait List updates are complete."
'DoCmd.OpenReport "rptWaitListUpdates", acViewNormal
DoCmd.OutputTo acOutputReport, strName, strOutputFormat, strPath, True

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "UPDATE tblTimeOff SET tblTimeOff.WL_Order = Null WHERE
(((tblTimeOff.WL_Order) Is Not Null) AND ((tblTimeOff.Approved)=-1))"
.Open
End With

Exit_cmdWaitList_Click:
If Not IsNull(rs) Then Set rs = Nothing
If Not IsNull(rsTeam) Then Set rs = Nothing
If Not IsNull(cn) Then Set cn = Nothing
Erase dteAvailDateAM
Erase dteAvailDateLP
Erase lngID
ReturnValue = SysCmd(acSysCmdRemoveMeter)
DoCmd.SetWarnings True
Exit Sub

Err_cmdWaitList_Click:
MsgBox Err.Description
Resume Exit_cmdWaitList_Click
End Sub


"Brendan Reynolds" wrote:

I'm finding the code very difficult to read, and I think it is not complete.
One thing that stands out, though, is that the original poster said that the
query returns eight records, but the source of the recordset is not the
query, but a SQL statement that selects from the query - how many of those
eight records meet the criteria of the SQL statement, i.e. [WL] 0 and
[Avail] 0?

--
Brendan Reynolds (MVP)
http://brenreyn.blogspot.com

The spammers and script-kiddies have succeeded in making it impossible for
me to use a real e-mail address in public newsgroups. E-mail replies to
this post will be deleted without being read. Any e-mail claiming to be
from brenreyn at indigo dot ie that is not digitally signed by me with a
GlobalSign digital certificate is a forgery and should be deleted without
being read. Follow-up questions should in general be posted to the
newsgroup, but if you have a good reason to send me e-mail, you'll find
a useable e-mail address at the URL above.


"Andi Mayer" wrote in message
...
On Tue, 11 Jan 2005 11:51:06 -0800, str8trini
wrote:

I hope Brendan steps in, because I am a DAO-orientated

but my expirence with ADO showed me:
you don't get a recordcount with ADO

therefore it everytime -1 (unknown)

Have you tried to walk through the rs?
While not rs.eof
debug.print rs.fields(0)
rs.movenext
wend


---
If you expect an answer to a personal mail, add the word "manfred" to the
first 10 lines in the message
MW

I'm sorry, I do not wish to offend, and I do of course understand your point
about being an amateur and being self taught, but I can not read this code.
I am not saying this in order to criticise, I am trying to explain why I am
unable to help you. I hope you will be successful in resolving your problem.

--
Brendan Reynolds (MVP)
http://brenreyn.blogspot.com

The spammers and script-kiddies have succeeded in making it impossible for
me to use a real e-mail address in public newsgroups. E-mail replies to
this post will be deleted without being read. Any e-mail claiming to be
from brenreyn at indigo dot ie that is not digitally signed by me with a
GlobalSign digital certificate is a forgery and should be deleted without
being read. Follow-up questions should in general be posted to the
newsgroup, but if you have a good reason to send me e-mail, you'll find
a useable e-mail address at the URL above.


"str8trini" wrote in message
...
I didn't think you would want the complete code so I just sent up to the
part
where I was getting the error. You are correct the source of the
recordset
was an SQL statement that selected from the query. I have since created
the
query to match exactly to my recordset. I still get the same result
though.
I added a line of code to open the query and the result is the eight
records.
However, rs.EOF is still true when the results should match that of the
openquery command. The complete revised code is attached. Please keep in
mind that I am an amateur at this and it was self taught so it may not
appear
to be very professionally written. Thanks!

'This procedure considers the ELF when updating from the WL
'and updates from the WL only when the requested shift does not
'exceed the threshold. It will override a person higher on the
'waitlist if the requested shift will put it over the limit.

On Error GoTo Err_cmdWaitList_Click
Dim cn As ADODB.Connection, rs As ADODB.Recordset, rsTeam As
ADODB.Recordset
Dim x As Integer, AvailDate As Date, Slots As Integer, WL_Count As
Integer,
strAM As String, strLP As String
Dim dteAvailDateAM() As Date, a As Integer, dteAvailDateLP() As Date, L As
Integer, dteWL_Date As Date
Dim lngID() As Long, lngRecID As Long, i As Integer, GrpAvail As Double,
intCount As Integer
Dim intE As Integer, intL As Integer, intF As Integer, Max As Integer,
intTeam As Long, ReturnValue As Variant

strAM = "Account Maintenance"
strLP = "Loss Prevention"

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rsTeam = New ADODB.Recordset


With rs
Set .ActiveConnection = cn
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
End With

With rsTeam
Set .ActiveConnection = cn
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
End With

DoCmd.SetWarnings False
DoCmd.OpenQuery "qryDelExpired"

ReDim lngID(0)
i = 1
ReDim dteAvailDateAM(0)
a = 1
ReDim dteAvailDateLP(0)
L = 1

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select Count(EligibleDates) AS RecCount FROM
sqlAvailSummAM"
.Open
End With

intCount = rs!RecCount

'Initialize progress meter.
ReturnValue = SysCmd(acSysCmdInitMeter, "Checking for WaitList
Updates-Account Maintenance", intCount)

AM:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "sqlAvailSummAM"
.Open
End With
DoCmd.OpenQuery "sqlAvailSummAM"

If rs.EOF Then
GoTo LP
End If

Do Until rs.EOF
ReDim Preserve dteAvailDateAM(a)
dteAvailDateAM(a) = rs!WL_Date
a = a + 1
rs.MoveNext
Loop

For a = 1 To UBound(dteAvailDateAM)
ReturnValue = SysCmd(acSysCmdUpdateMeter, a)
dteWL_Date = dteAvailDateAM(a)
'AM Specialty
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct,
GroupThreshold, Avail FROM qryTimeOffAvailSummAM WHERE Avail 0 AND WL 0
AND
Specialty = -1 AND EligibleDates = #" & dteWL_Date & "#"
.Open
End With

If rs.EOF Then
GoTo AM_NonSpec
End If

Slots = CLng(rs!Avail + 0.1)
intE = rs!E_Ct
intL = rs!L_Ct
intF = rs!F_Ct
Max = rs!GroupThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitList WHERE DeptName = '" & strAM & "'" & " and Specialty = -1 and
DateBegin = #" & dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If

ElseIf rs!AmountOff = "L" And (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And ((Max - (intF + intE)) = 1 And
(Max -
(intF + intL)) = 1) Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x

'AM Non Specialty
AM_NonSpec:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct,
GroupThreshold, Avail FROM qryTimeOffAvailSummAM WHERE [Avail] 0 AND WL
0
AND Specialty = 0 AND EligibleDates = #" & dteWL_Date & "#"
.Open
End With

Slots = CLng(rs!Avail + 0.1)
intE = rs!E_Ct
intL = rs!L_Ct
intF = rs!F_Ct
Max = rs!GroupThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitList WHERE DeptName = '" & strAM & "'" & " and Specialty = 0 and
DateBegin = #" & dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And ((Max - (intF + intE)) = 1 And
(Max -
(intF + intL)) = 1) Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
Next a

LP:
With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select DISTINCT Count(EligibleDates) AS RecCount FROM
qryTimeOffAvailGroupLP"
.Open
End With

intCount = rs!RecCount
'Reset status text
ReturnValue = SysCmd(acSysCmdClearStatus)
'Initialize progress meter.
ReturnValue = SysCmd(acSysCmdInitMeter, "Checking for WaitList
Updates-Loss
Prevention", intCount)

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select DISTINCT EligibleDates AS WL_Date FROM
qryTimeOffAvailGroupLP"
.Open
End With

If rs.EOF Then
GoTo Fini****
End If

Do Until rs.EOF
ReDim Preserve dteAvailDateLP(L)
dteAvailDateLP(L) = rs!WL_Date
L = L + 1
rs.MoveNext
Loop

For L = 1 To UBound(dteAvailDateLP)
dteWL_Date = dteAvailDateLP(L)
ReturnValue = SysCmd(acSysCmdUpdateMeter, L)
'LP Specialty
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, SumOfE_Ct As E_Ct, SumOfL_Ct
As L_Ct, SumOfF_Ct As F_Ct, GroupThreshold, GroupAvail FROM
qryTimeOffAvailGroupLP_Spec WHERE EligibleDates = #" & dteWL_Date & "#"
.Open
End With

If rsTeam.EOF Then
GoTo LP1
End If

Slots = CLng(rsTeam!GroupAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!GroupThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitList WHERE DeptName = '" & strLP & "'" & " AND Specialty = -1 AND
DateBegin = #" & dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If

ElseIf rs!AmountOff = "L" And (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And ((Max - (intF + intE)) = 1 And
(Max -
(intF + intL)) = 1) Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
rs.MoveNext
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x

'LP Non-Specialty
LP1:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP1' AND EligibleDates = #" & dteWL_Date
&
"#"
.Open
End With

If rsTeam.EOF Then
GoTo LP2
End If

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop

LP2:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP2' AND EligibleDates = #" & dteWL_Date
&
"#"
.Open
End With

If rsTeam.EOF Then
GoTo LP3
End If

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop

LP3:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP3' AND EligibleDates = #" & dteWL_Date
&
"#"
.Open
End With

If rsTeam.EOF Then
GoTo LP4
End If

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop

LP4:
With rsTeam
If rsTeam.State = adStateOpen Then
.Close
End If
.Source = "Select EligibleDates, E_Ct, L_Ct, F_Ct, TeamID,
TeamThreshold, GroupAvail, TeamAvail FROM qryTimeOffAvailGroupLP WHERE
Specialty = 0 AND ThresholdID = 'LP4' AND EligibleDates = #" & dteWL_Date
&
"#"
.Open
End With

GrpAvail = rsTeam!GroupAvail

Do Until GrpAvail = 0 Or rsTeam.EOF
intTeam = rsTeam!teamid
Slots = CLng(rsTeam!TeamAvail + 0.1)
intE = rsTeam!E_Ct
intL = rsTeam!L_Ct
intF = rsTeam!F_Ct
Max = rsTeam!TeamThreshold

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "SELECT TO_ID, CompassID, AmountOff FROM
qryWaitListLP_Team WHERE TeamID =" & intTeam & "AND DateBegin = #" &
dteWL_Date & "# ORDER BY WL_Order"
.Open
End With

For x = 1 To Slots
If rs!AmountOff = "E" And GrpAvail = 0.5 Then
If (Max - (intF + intE)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intE = intE + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "L" And GrpAvail = 0.5 Then
If (Max - (intF + intL)) = 1 Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intL = intL + 1
GrpAvail = GrpAvail - 0.5
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
ElseIf rs!AmountOff = "F" And GrpAvail = 1 Then
If ((Max - (intF + intE)) = 1 And (Max - (intF + intL)) = 1)
Then
ReDim Preserve lngID(i)
lngID(i) = rs!TO_ID
i = i + 1
intF = intF + 1
GrpAvail = GrpAvail - 1
rs.MoveNext
End If
If rs.EOF Then
Exit For
End If
Else
rs.MoveNext
x = x - 1
If rs.EOF Then
Exit For
End If
End If
Next x
rsTeam.MoveNext
Loop
Next L

Fini****:
For i = 1 To UBound(lngID)
lngRecID = lngID(i)

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "Select TO_ID, Reason, Approved, UpdateTime, UpdateUser
FROM tblTimeOff WHERE TO_ID = " & lngRecID & ""
.Open
End With

rs!Reason = 5
rs!Approved = -1
rs!UpdateTime = Now()
rs!UpdateUser = CurrentUser()
rs.Update

Next i

Dim strOutputFormat As String, strName As String, strPath As String
strOutputFormat = "Snapshot Format"
strName = "rptWaitListUpdates"
'strPath = "C:\Attendance\rptWaitListUpdates.snp"
strPath = "W:\SchdAttn\Data\WaitListUpdates.snp"

MsgBox "Wait List updates are complete."
'DoCmd.OpenReport "rptWaitListUpdates", acViewNormal
DoCmd.OutputTo acOutputReport, strName, strOutputFormat, strPath, True

With rs
If rs.State = adStateOpen Then
.Close
End If
.Source = "UPDATE tblTimeOff SET tblTimeOff.WL_Order = Null WHERE
(((tblTimeOff.WL_Order) Is Not Null) AND ((tblTimeOff.Approved)=-1))"
.Open
End With

Exit_cmdWaitList_Click:
If Not IsNull(rs) Then Set rs = Nothing
If Not IsNull(rsTeam) Then Set rs = Nothing
If Not IsNull(cn) Then Set cn = Nothing
Erase dteAvailDateAM
Erase dteAvailDateLP
Erase lngID
ReturnValue = SysCmd(acSysCmdRemoveMeter)
DoCmd.SetWarnings True
Exit Sub

Err_cmdWaitList_Click:
MsgBox Err.Description
Resume Exit_cmdWaitList_Click
End Sub


"Brendan Reynolds" wrote:

I'm finding the code very difficult to read, and I think it is not
complete.
One thing that stands out, though, is that the original poster said that
the
query returns eight records, but the source of the recordset is not the
query, but a SQL statement that selects from the query - how many of
those
eight records meet the criteria of the SQL statement, i.e. [WL] 0 and
[Avail] 0?

--
Brendan Reynolds (MVP)
http://brenreyn.blogspot.com

The spammers and script-kiddies have succeeded in making it impossible
for
me to use a real e-mail address in public newsgroups. E-mail replies to
this post will be deleted without being read. Any e-mail claiming to be
from brenreyn at indigo dot ie that is not digitally signed by me with a
GlobalSign digital certificate is a forgery and should be deleted without
being read. Follow-up questions should in general be posted to the
newsgroup, but if you have a good reason to send me e-mail, you'll find
a useable e-mail address at the URL above.


"Andi Mayer" wrote in message
...
On Tue, 11 Jan 2005 11:51:06 -0800, str8trini
wrote:

I hope Brendan steps in, because I am a DAO-orientated

but my expirence with ADO showed me:
you don't get a recordcount with ADO

therefore it everytime -1 (unknown)

Have you tried to walk through the rs?
While not rs.eof
debug.print rs.fields(0)
rs.movenext
wend


---
If you expect an answer to a personal mail, add the word "manfred" to
the
first 10 lines in the message
MW