parajrn
asked on
PAL Duplicate Check to VBA Code
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,
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
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.
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.
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
ASKER
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.
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.
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.
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.