loading a sorted dataset and comparing current with previous record in vba

joe789

Registered User.
Local time
Today, 21:56
Joined
Mar 22, 2001
Messages
154
Hi Folks,

Wondering if someone can help me with the necessary structure and/or keywords to get this rolling. Assume I have a base table in access, the table is sorted in a particular fashion so that logically you can step thru the records comparing the current record with the previous record to determine what you need to. How would I create a vba module that will load this base table, step thru the records in the sorted method comparing the current record with the previous so that if a certain criteria is found/met it records that in either another table or can append/update a field in the existing table? For example: if I have a 1000 row table in access named [1000RowTable] that contains a normalized representation of UserID, ServiceDate, ServiceProcedure and that table is sorted in ascending order for those fields ... I would want to load that table into vba and have vba go thru the sorted table row by row comparing the current UserID with the previous UserID, if the Current UserID matches the Previous UserID then perhaps I would want a 'Yes' in a new table along with the fields that were used in the compare and if 'No' then perhaps execute some other code. Any help in terms of formatting or VBA keywords/actions that I would need to use would be awesome. Obviously when the last record, I would want to properly close out of the recordset. I am just trying to figure out how to load a recordset in terms of an access table and how to hold a record whilst comparing it to a previous record in a sorted dataset and executing code if certain criteria match or not and then closing up afterwards. I have cheated and used excel to help with a bunch of stuff when I needed to compare current with previous but would like to learn how to do something similar with VBA.

Thank you,

Joe
 
Here's some vba that deals with the underlying concept. Where I have used message boxes to display a condition, you would substitute the Code (base on the matches previous record OR doesn't match previous record).

You could set this up and try it quite easily.

I have a table- AnimalOwners. Someone wants to send only 1 letter to each Owner, but an Owner can own several animals.
Table: AnimalOwner
OwnerId AnimalId AnimalName
1 20 Spot
2 243 Gary
2 32 Trixy
3 12 Patches
3 98 Boston
31 213 Geronimo
31 235 Hank
31 24 Roxy
4 2345 PyeWackid

Code:
'---------------------------------------------------------------------------------------
' Procedure : Letters
' Author : Jack
' Created : 4/7/2011
' Purpose : To identify Owners, so only 1 letter is sent to Animal Owner.
' The issue is that some owners own multiple animals.
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
'------------------------------------------------------------------------------
'
Sub Letters()
Dim holding_Owner As String
Dim sPet As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo Letters_Error

Set db = CurrentDb
Set rs = db.OpenRecordset("SElect * from ownerAnimals order by ownerid")
holding_Owner = rs!ownerID
Do While Not rs.EOF
If rs!ownerID = holding_Owner Then
'same Owner
MsgBox "Build letter with " & rs!ownerID & " and " & rs!animalname
Debug.Print "Build letter with " & rs!ownerID & " and " & rs!animalname
sPet = sPet & " " & rs!animalname
Else
'different owner
MsgBox "Write letter(s) for Ownerid = " & holding_Owner & " " & sPet
Debug.Print "Write letter(s) for Ownerid = " & holding_Owner & " " & sPet
holding_Owner = rs!ownerID
sPet = rs!animalname
End If
rs.MoveNext
Loop
'Catch the last owner here
MsgBox "Write letter(s) for Ownerid = " & holding_Owner & " " & sPet
Debug.Print "Write letter(s) for Ownerid = " & holding_Owner & " " & sPet
rs.Close

On Error GoTo 0
Exit Sub

Letters_Error:

MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure Letters of Module AWF_Related"
End Sub

Hope it's helpful.
 

Users who are viewing this thread

Back
Top Bottom