Solved

MS Access DAO Recordset sorting bug in VB6?

Posted on 2009-06-30
7
1,176 Views
Last Modified: 2012-05-07
Hello,

I am using Access 2002 and VB6.

I'm attempting to compare 2 similar tables in the same db file, and show the changes.

Each table has over 224,000 rows, and if they are slightly different or absolutely identical, I get the same problem.....

I load each table into recordsets (rs1 and rs2) via DAO and an SQL query and then cycle through each entry (rs.MoveNext) and compare the field values (rs.Fields(i))

Here is an example of the issue:

The following entries are identical in both tables

Name      Last Known Address      Amount      Description      Year      Organisation
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $62.50      DEPOSIT      1993      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $140.00      DEPOSIT      1992      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $140.00      DEPOSIT      1992      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $143.50      DEPOSIT      1993      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $143.50      DEPOSIT      1993      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 pearsons Lane Robertson      $143.50      DEPOSIT      1993      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $143.50      DEPOSIT      1993      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $145.00      DEPOSIT      1994      WOLNG CITY CNCL
PYNENBURG CONSTRUCTIONS      331 Pearsons Lane Robertson      $335.00      DEPOSIT      1997      WOLNG CITY CNCL

If you look carefully there are 2 entries with $143.50, but one of the address street-name; "Pearsons" starts with a lower case "p" and one is an upper case "P"

rs2 puts them in the correct ascii sort order, "P" before "p"

but rs1 puts "p" before "P"

is it a sort priority issue or a bug?

help! :)

thanks,
Chris

Set db = DBEngine.OpenDatabase(OSR_DB)
 

    query = "select * from " & CURRENT_TABLE & " order by Name, [Last Known Address], Amount, Description, Year, Organisation"

    Set rs1 = db.OpenRecordset(query)
 

    query = "select * from " & TEMP_TABLE & " order by Name, [Last Known Address], Amount, Description, Year, Organisation"

    Set rs2 = db.OpenRecordset(query)

Open in new window

0
Comment
Question by:schmuck2
  • 3
  • 3
7 Comments
 
LVL 77

Accepted Solution

by:
peter57r earned 500 total points
ID: 24752060
Jet is not case sensitive.
The different resuts are just occurring by chance.

If you want to force a case sensitive order you would have to use a convert to hex function on your address field and sort on the result of the function.
0
 

Author Comment

by:schmuck2
ID: 24752196
thanks Peter,
can you supply the code? :)
cheers
0
 
LVL 77

Expert Comment

by:peter57r
ID: 24752229
Function StrToHex(S As Variant) As Variant
'
' Converts a string to a series of hexadecimal digits.
' For example, StrToHex(Chr(9) & "A~") returns 09417E.
'
   Dim Temp As String, I As Integer
      If VarType(S) <> 8 Then
         StrToHex = S
      Else
         Temp = ""
      For I = 1 To Len(S)
         Temp = Temp & Format(Hex(Asc(Mid(S, I, 1))), "00")
      Next I
         StrToHex = Temp
      End If
End Function
0
Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 

Author Comment

by:schmuck2
ID: 24753225
thanks for that
I had an even better idea
when I do the compare between the fields of rs1 and rs2, I now UCase() both values
it works a treat
thanks for your initial comment
will award full points
0
 
LVL 5

Expert Comment

by:BrianVSoft
ID: 24753264
It seems one of these tables is a replica of the other and that they are an Indexed recordset (Ie. there would be a Primary Key)
If there is a primary key, you should be using that to compare the records!
You should never use movenext on two record sets to compare them - that will fail if a record has been deleted.
1. You could add that primary key to an "ORDER BY" clause to ensure both records are in the same order and then as you movenext thru both sets you can check to see if the fields used by that key are the same (that will cover a deleted record) If you need to check the upper/lower case of Names etc. use the Option Compare Binary mode.
2. You could open the tables directly via DAO, Set the Tables.Index = to the Primary key, MoveNext thru one table, Table2.Seek "=", Key2, Key2 each record in the other table and see if you get a Table2.NoMatch
0
 
LVL 77

Expert Comment

by:peter57r
ID: 24753326
Yes that is simpler.
But from the way you expressed the Q i assumed that you wanted to identify the difference in case as a genuine difference.

If you don't care about case then you can just test
if t1.field1 = t2.field1 then ...... as Access will ignore case.

(unless you have set Option Compare Binary at the top of your module)
0
 

Author Comment

by:schmuck2
ID: 24759185
Hi Brian,
thanks for the advice
My code is now working perfect (attached)
thanks for your help guys
Sub CompareTables()
 

Dim db As DAO.Database

Dim rs1 As DAO.Recordset

Dim rs2 As DAO.Recordset

Dim i As Integer

Dim query As String

Dim rs1Size As Long

Dim rs1Pos As Long

Dim value1 As String

Dim value2 As String

Dim compare_value As Integer
 

    lblStatus = "Loading and Sorting Table RecordSets...."

    Me.Refresh

    

    Set db = DBEngine.OpenDatabase(OSR_DB)
 

    query = "select * from [" & CURRENT_TABLE & "] order by Name, [Last Known Address], Amount, Description, Year, Organisation"

    Set rs1 = db.OpenRecordset(query)
 

    query = "select * from [" & TEMP_TABLE & "] order by Name, [Last Known Address], Amount, Description, Year, Organisation"

    Set rs2 = db.OpenRecordset(query)
 

    rs1Size = rs1.RecordCount

    rs1Pos = 1

    

    lblStatus = "Comparing Records and Updating Table...."

    Me.Refresh

    

    Do Until rs2.EOF

                    

        If rs1Pos > rs1Size Then 'new records at end of temp table

            rs1.AddNew

            For i = 0 To 5

                If LenB(rs2(i)) <> 0 Then rs1(i) = rs2(i)

            Next i

            'add "Date Added"

            rs1(6) = Format(Now, "d/mm/yyyy")

            rs1.Update

            rs2.MoveNext

        Else

            'compare values

            compare_value = 0

            For i = 0 To 5

                'access ignore hyphens when sorting, so remove them for comparison test

                'access also ignores case, so UCase everything

                value1 = UCase(Replace("" & rs1.Fields(i), "-", ""))

                value2 = UCase(Replace("" & rs2.Fields(i), "-", ""))

                If value1 > value2 Then 'new record

                    compare_value = 1

                    Exit For

                ElseIf value1 < value2 Then 'removed record

                    compare_value = -1

                    Exit For

                End If

            Next

                

            If compare_value = 0 Then 'matching record

                rs1Pos = rs1Pos + 1

                rs1.MoveNext

                rs2.MoveNext

            ElseIf compare_value = 1 Then 'new record

                rs1.AddNew

                For i = 0 To 5

                    If LenB(rs2(i)) <> 0 Then rs1(i) = rs2(i)

                Next i

                'add "Date Added"

                rs1(6) = Format(Now, "d/mm/yyyy")

                rs1.Update

                rs2.MoveNext

            ElseIf compare_value = -1 Then 'removed record

                'add "Date Removed" (only if already blank)

                If IsNull(rs1(7)) Then

                    rs1.Edit

                    rs1(7) = Format(Now, "d/mm/yyyy")

                    rs1.Update

                End If

                rs1Pos = rs1Pos + 1

                rs1.MoveNext

            End If

        End If

    Loop
 

     'records removed from end of table?

     If rs2.EOF And rs1Pos < rs1Size Then

        Do Until rs1Pos > rs1Size

            'add "Date Removed" (only if already blank)

            rs1.Edit

            If IsNull(rs1(7)) Then

                rs1(7) = Format(Now, "d/mm/yyyy")

            End If

            rs1.Update

            rs1.MoveNext

            rs1Pos = rs1Pos + 1

        Loop

    End If

    

    rs1.Close

    rs2.Close

    

End Sub

Open in new window

0

Featured Post

Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now