RecordSet Loop and Compare 1

[CopperWire]

I need to compare one field (WR) in the database to the previous field (WR) and if they equal performe a calculation (daydiff-daydiff). I need to loop through the entire database.

read second row [wr] field
If equal to previous row [wr] field
[daydiff] previous record – [daydiff] current record

Do this until EOF.

Any help would be appreciated!

 

[Page410]

Try something like this. I made the assumption that you are updating a field on the table with the results of your calculation. Untested but it should work. Let me know if this helps.

function compareandcalculate()
dim dbs as dao.database
dim rst as dao.recordset
dim valueA, valueB as integer

set dbs = currentdb
set rst = dbs.openrecordset("tblTableName",dbsopendynaset)

with rst
.movefirst
while not rst.eof
valueA = rst![comparedfield]
.movenext
valueB = rst![comparedfield]
if valueA = valueB then
rst.edit
rst![calculationresult] = valueA - valueB
rst.update
else
end if
wend
set rst = nothing
set dbs = nothing
end function

 

[CopperWire]

Thanks so much for your help. I've been so busy I just got a chance to try this. I put the code in a text box on a form and when I click on the box to set off the event I get the following error:

user-defined type not defined. I've tried DAO and ADO and I get the same error.

Please help. I've pasted the code below.

Option Compare Database

Private Sub Text40_Click()
Dim dbs As DAO.Database
Dim rst As ADO.Recordset
Dim valueA, valueB As Integer

Set dbs = SchedulingPM
Set rst = dbs.openrecordset("Scheduling_data", dbsopendynaset)

With rst
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
.MoveNext
valueB = rst![cd_wr]
If valueA = valueB Then
rst.edit
rst![calculationresult] = valueA - valueB
rst.Update
Else
End If
Wend
Set rst = Nothing
Set dbs = Nothing

End Sub

 

[Page410]

Try these changes:
1) Make sure that both the dbs and rst are DAO.
2) If you are using dates in your calculation, set valueA and valueB as dates when dimming them.
3) Add the option explicit to the module
4) Try to use the DateDiff() function to perform your calculation.

I've put the changes into the following code. Try putting a break point in at the beginning of the code and step through it to find out exactly where it's bombing out. Give that a try and let me know how it works.

Mike

Option Compare Database
Option Explicit

Private Sub Text40_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim valueA, valueB As Date

Set dbs = SchedulingPM
Set rst = dbs.openrecordset("Scheduling_data", dbsopendynaset)

With rst
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
.MoveNext
valueB = rst![cd_wr]
If valueA = valueB Then
rst.edit
rst![calculationresult] = DateDiff("d",valueA, valueB)
rst.Update
Else
End If
Wend
Set rst = Nothing
Set dbs = Nothing

End Sub

 

[CopperWire]

I still get the same error:

Option Compare Database
Option Explicit

Private Sub Text40_Click()
Dim dbs As DAO.Database

It the first line that's getting hit. It flags dbs As DAO.Database.

Any ideas?

 

[Page410]

Try this without changing anything.
1) When setting the dbs, if the data is in the current database then you have to enter CurrenDB

Also, in setting rst, there was dbsopendynaset. This should have been dbOpenDynaset, without the 's'.




Private Sub Text40_Click()Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim valueA, valueB As Date

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Scheduling_data", dbOpenDynaset)

With rst
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
.MoveNext
valueB = rst![cd_wr]
If valueA = valueB Then
rst.Edit
rst![calculationresult] = DateDiff("d", valueA, valueB)
rst.Update
Else
End If
Wend
End With

Set rst = Nothing
Set dbs = Nothing

End Sub

 

[CopperWire]

I tried that, but it keeps getting hung up on the same line! I've tried everything I can think of any other ideas?

 

[Page410]

You might want to check your references. Check to see if you have "Microsoft DAO 3.6 Object Library" as one of your selected references. If you dont, select it.

or try removing the "DAO." from the dbs and rst lines so that they look like the lines below.

Dim dbs as Database
Dim rst as Recordset

 

[cjsorel]

Just open up your VBA editor, go to the Tools menu, choose References, check off the ADO entry, find DAO 3.x, check it on, and exit the dialogue box. Now the code will work.

 

[CopperWire]

Your absolutely right, that was the problem. Thanks! However, when I run through the code, the result (If Value A = Value B) is always false because the records don't appear to be sorted. I sorted the records on the form that runs this code and I sorted them in the table, however, I'm not getting the results I would expect.

What I'm trying to do, is if the CD_WR from the first record and the next record equal, then calculate the date differnce from the same two records ValueC and ValueD and put results in the table in a field called calculationresult. Any Ideas?



Private Sub Text40_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim valueA, valueB As Long
Dim valueC, valueD As Date

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Scheduling_data", dbOpenDynaset)

With rst
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
valueC = rst![dt_sched]
.MoveNext
valueB = rst![cd_wr]
valueD = rst![dt_sched]
If valueA = valueB Then
rst.Edit
rst![calculationresult] = DateDiff("d", valueC, valueD)
rst.Update
Else
.MoveNext
End If
Wend
End With

Set rst = Nothing
Set dbs = Nothing

End Sub

 

[Page410]

Try removing your second .MoveNext. By having 2 of these in the code, you wont compare every record to the next.

'With one movenext
start loop
line 1
.MoveNext (goes to line 2)
Compare line 1 and 2
start loop
line 2
.MoveNext (goes to line 3)
Compare line 2 and 3

'With two movenext
start loop
line 1
.MoveNext (goes to line 2)
Compare line 1 and 2
.MoveNext (goes to line 3)
start loop
line 3
.MoveNext (goes to line 4)
Compare line 3 and 4

Do you see what I mean? If you have .MoveNext in the code twice, line 2 never gets compared to line 3.

 

[CopperWire]

I do see what you mean, so I did remove it. However, I'm still not getting the first record as it is on the form or in the table. The first value I'm getting is 1195, which is record 2605. The second value is 6600, which is record 5635.

I even tried adding the following code:

Set Me.Recordset = Forms!Scheduling_data.Recordset

This doesn't work either.

Once again out of ideas. Do you have any?

 

[Page410]

You must have the table sorted on something aside from your indexed field. You could try usind an sql statement instead of a table to build the recordset, adding your own order. You can build the SQL easily enough using the query builder and then switching to SQL view.

Here are the elements that you would add to do this.

dim strSQL as string

strSQL = "SELECT Scheduling_data.* FROM Scheduling_data ORDER ON Scheduling_data.myKeyField;"

set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)

 

[CopperWire]

Now I get Object Variable or With Block Variable not set. I thought I was doing this right!

Option Compare Database
Option Explicit
Private Sub Text40_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Scheduling_data.* FROM Scheduling_data ORDER ON Scheduling_data.cd_wr, Scheduling_data.batch_dt;"

Dim valueA, valueB As Long
Dim valueC, valueD As Date
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
'Set dbs = CurrentDb
'Set rst = dbs.OpenRecordset("Scheduling_data", dbOpenDynaset)

With rst
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
valueC = rst![dt_sched]
.MoveNext
valueB = rst![cd_wr]
valueD = rst![dt_sched]
If valueA = valueB Then
rst.Edit
rst![calculationresult] = DateDiff("d", valueC, valueD)
rst.Update
Else
End If
Wend
End With

Set rst = Nothing
Set dbs = Nothing

End Sub

HELP Again, Please. We're soooo close!

 

[Page410]

Uncomment the following line
set dbs = CurrentDB

 

[CopperWire]

Just F.Y.I., below is the final code and it work!!!! Thank you so much for your help, I couldn't have figured this out without your help. I even gave you a star!

Option Compare Database
Option Explicit
Private Sub Text40_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Scheduling_data.* FROM Scheduling_data ORDER BY Scheduling_data.cd_wr, Scheduling_data.batch_dt;"

Dim valueA, valueB As Long
Dim valueC, valueD As Date
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)

'Set rst = dbs.OpenRecordset("Scheduling_data", dbOpenDynaset)

With rst
.MoveLast
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
valueC = rst![dt_sched]
.MoveNext
If Not rst.EOF Then
valueB = rst![cd_wr]
valueD = rst![dt_sched]
If valueA = valueB Then
rst.Edit
rst![calculationresult] = DateDiff("d", valueC, valueD)
rst.Update
Else
End If

End If
Wend
End With

Set rst = Nothing
Set dbs = Nothing

End Sub


Lisa

 

[Page410]

Glad it worked out for you. As a final note, you should probably make this a function and just call it from your event procedure.

Happy coding!

 

[CopperWire]

Hi Again!

I was wondering if you could help me deal with Null values. I passed my rst from on sub to another in order to build off of the first one. The code is below.

Option Compare Database
Option Explicit
Private Sub Calcualtion()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Scheduling_data.* FROM Scheduling_data ORDER BY Scheduling_data.cd_wr, Scheduling_data.batch_dt;"

Dim valueA, ValueB As Long
Dim valueC, valueD As Date
Dim valueE, ValueF As Date
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)

'Set rst = dbs.OpenRecordset("Scheduling_data", dbOpenDynaset)

With rst
.MoveLast
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
valueC = rst![dt_sched]
valueE = rst![batch_dt]
.MoveNext
If Not rst.EOF Then
ValueB = rst![cd_wr]
valueD = rst![dt_sched]
ValueF = rst![batch_dt]
If valueA = ValueB Then
rst.Edit
rst![Date_Diff] = DateDiff("d", valueC, valueD)
rst![SchMove] = DateDiff("d", valueE, ValueF)
rst.Update
Else
End If
End If
Wend
End With

Call MoreCalculate(rst)

Set rst = Nothing
Set dbs = Nothing


End Sub
__________________________________________________________
Public Sub MoreCalculate(rst)
Dim valueA, ValueB As Long
Dim valueC, valueD As Date
Dim valueE, ValueF As Date
Dim valueG, ValueH As Long

With rst
.MoveLast
.MoveFirst
While Not rst.EOF
valueA = rst![cd_wr]
valueG = rst![Date_Diff]
.MoveNext
If Not rst.EOF Then
ValueB = rst![cd_wr]
ValueH = rst![Date_Diff]

(I get the error right here. Is is a run time 94 error "Invalid Use of Null" ) I've tried setting the [Date_Diff to a value if it's Null, but that didn't work. Any ideas would be appreciated. Thanks!

If valueA = ValueB And valueG > ValueH Then
rst.Edit
rst![Least] = ValueH
rst.Update
Else
If valueA = ValueB And valueG < ValueH Then
rst.Edit
rst![Least] = valueG
rst.Update
End If
End If
End If

Wend
End With

End Sub

 

[Page410]

Try using the Nz function

ValueH = Nz(rst![Date_Diff],0)

If rst![Date_Diff] is null, it will replace the null value with a 0.

 

[CopperWire]

Thanks, that's a handy feature I didn't know about. Works great!!