PAL Duplicate Check to VBA Code

parajrn
parajrn used Ask the Experts™
on
I'm currently working to modernize a legacy database from Paradox 4.0 to Access Beta 10 and I'm currently doing the final tuneups however there is a script from the Paradox system that I'm not sure how to recreate in VBA (as I normally do PHP/SQL systems rather than Access) and I wanted to know if anyone could provide any assistance.

In a nutshell if you don't fully understand PAL, the script takes the data in the current database (manually sorted before hand in order of the ID and date updated field) and compares the values of each record side by side to see if there are any duplicates.

Thanks very much in advance,
;before using this script be sure to sort the datafile in
;1st priority=match field, 2nd priority=date 1
proc update()
     [Activity_8] = [Activity_7]
     [Activity_7] = [Activity_6]
     [Activity_6] = [Activity_5]
     [Activity_5] = [Activity_4]
     [Activity_4] = [Activity_3]
     [Activity_3] = [Activity_2]
     [Activity_2] = [Activity_1]
     [Activity_1] = curr_act1
     [date_8] = [date_7]
     [date_7] = [date_6]
     [date_6] = [date_5]
     [date_5] = [date_4]
     [date_4] = [date_3]
     [date_3] = [date_2]
     [date_2] = [date_1]
     [date_1] = curr_date1
     [date_updat] = curr_update
     if (isblank(curr_journ) = false) then
        [Journal_2] = [Journal_nu]
        [Journal_nu] = curr_journ
     endif   
endproc
     
proc read_input()
     window create @1,0 width 78 height 10 to canvaswindow
     echo normal
     @1, 1
     ?? "Enter the drive letter and filename then press enter-> "
     accept "A25" to dfile
     @2,1
     ?? "Enter the drive letter and a new filename then press enter-> "
     accept "A25" to fishy
     window close
endproc


read_input()
CREATE fishy LIKE dfile
edit fishy
DO_IT!
edit dfile
n = nrecords(dfile)
while (isblank([match]) = false)
      for i from 1 to n
          ref_match = [match]
          ref_act1 = [activity_1]
          ref_date1 = [date_1]
          ref_email = [email]
          down
          curr_match = [match]
          if (curr_match = ref_match) then
             if (isblank([date_1]) = true) then
                [date_1] = [date_updat]
             endif   
             curr_date1 = [date_1]
             curr_act1 = [activity_1]
             curr_tel = [telephone]
             curr_email= [email]
             if ((curr_date1 <> ref_date1) or (curr_act1 <> ref_act1)) then
                curr_update = [date_updat]
                curr_journ = [journal_nu]
                up
                if ((isblank([journal_nu]) = false) and (isblank([journal_2]) = false)) then
                   copytoarray two_journs
                   upimage
                   copyfromarray two_journs
                   down
                   downimage
                endif    
                if (isblank(curr_tel) = false) then
                   [telephone] = curr_tel
                endif
                if (isblank(curr_email)=false) then
                        [email] = curr_email
                endif
                update()
                down            
                copytoarray del_rec
                upimage
                copyfromarray del_rec
                down
                downimage
                del
                up
             else
                  up
                  if (isblank(curr_tel) = false) then
                        [telephone] = curr_tel
                  endif
                  if (isblank(curr_email)=false) then
                        [email] = curr_email
                  endif
                  down
                  copytoarray del_rec
                  upimage
                  copyfromarray del_rec
                  down
                  downimage
                  del
                  up
             endif
           ;  n = nrecords(fname) + 1
          endif   
      endfor
endwhile

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
You can use the find duplicate records query wizard. As semi the navigation to it in the same in Access Beta 10, goto queries, new, find duplicates query wizard.
Dale FyeOwner, Dev-Soln LLC
Most Valuable Expert 2014
Top Expert 2010

Commented:
How do you define duplicates, just on the ID and DateUpdated fields, or are there other fields to consider?

What does it do with duplicates?  If all you want to do is delete the duplicates, then the find duplicates wizard is really not very useful.  If you are defining dups by only the ID and DateUpdated field, and you want do delete the duplicates without regard for any of the other fields in the table, then the following code (modified for your table names of course) should work, or give you an idea where to start.
Public Sub DeleteDups()

    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim intID As Integer
    Dim dtUpdated As Date
    
    strSQL = "SELECT yourTable.* INTO yourTableBackup " _
           & "FROM yourTable "
    CurrentDb.Execute strSQL, dbFailOnError
    
    strSQL = "SELECT * FROM yourTableBackup " _
           & "ORDER BY ID, DateUpdated"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    intID = -1
    dtUpdated = 0
    
    While Not rs.EOF
        If rs("ID") <> intID Or rs("DateUpdated") <> dtUpdated Then
            intID = rs("ID")
            dtUpdated = rs("DateUpdated")
        Else
            rs.Delete
        End If
        rs.MoveNext
    Wend
    
    rs.Close
    Set rs = Nothing
    
End Sub

Open in new window

Author

Commented:
The main goal of the system is to remove the duplicates however, we need to be able to select the record that is the oldest of the multiples, so that we only retain updated records.
How to Generate Services Revenue the Easiest Way

This Tuesday! Learn key insights about modern cyber protection services & gain practical strategies to skyrocket business:

- What it takes to build a cloud service portfolio
- How to determine which services will help your unique business grow
- Various use-cases and examples

Dale FyeOwner, Dev-Soln LLC
Most Valuable Expert 2014
Top Expert 2010

Commented:
If you actually want to be able to review the records, then the find duplicates query that "thenelson" posted would be one way to do it.  Use that as the RecordSource for a form that allows you to review the records and select the one to delete.

However, if you know that you want to save the most recent of the duplicates, you just need to change the sort order of the select query so that the most recent DateUpdated shos up first for each ID value.

strSQL = "SELECT * FROM yourTableBackup " _
           & "ORDER BY ID, DateUpdated DESC"

BTW, the code I posted backed up the original table, and deleted the dups from the backup, not the original.
Dale FyeOwner, Dev-Soln LLC
Most Valuable Expert 2014
Top Expert 2010

Commented:
Darn it.  Now that I think about it, my test file deleted records that duplicated the ID and DateUPdated fields.  You would need to modify my original code to check for ID values that are equal, and DateUpdated values that are less then the original one.
    'loop through all the records
    While Not rs.EOF 
        If rs("ID") <> intID Then
            'if the ID value of the current record is different
            'than the previous, then save the ID and DateUpdated
            'values
            intID = rs("ID") 
            dtUpdated = rs("DateUpdated")
        Else
            'If the ID values are the same, but the DateUpdated
            'is older, then delete the older value
            if rs("DateUpdated") < dtUpdated Then 
                rs.Delete
            endif
        End If 
        rs.MoveNext 
    Wend 

Open in new window

Commented:
Apologies for letting this question slide. The project involved has been put on a hiatus which is why I forgot about it. I'll have to close this for the time being since I don't have a working product yet.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial