How to keep 3 records of X in a 'multi-dubbled' DB

[Corwyn]

Hello,

I've got a database with a lot of identical number but with different other information in the record.
As I have more than 3 times the same number I would like to take the 3 first and delete the others.
How can I do that?
Could you help me asap?

 

[SJMcAbney]

Can you describe your tables please? How do you determine the first three?

Stewart

 

[Corwyn]

How to detremine... randomly! Doesn't matter wich 3 are remaining.
Table descrition:
PHone number|Company|Name
111|me inc.|John
111|me inc|Mark
111|me inc|Bob
111|me inc|Bill
112|you inc|fred
112|you corp|Ron
113|them|William
...
I would like to keep 113, all 112 and only 3 of the 111, doesn't matter wich one (the 3 first by example)

 

[SJMcAbney]

A bit nasty but should work. I tested it on a small database sample.

You'll need to change the following values:

Table1 to the name of your table
TableID to the name of the duplicate field

Public Function TidyMyData() As Boolean

Const MyTable As String = "Table1"

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(MyTable)
Dim intID As Integer
Dim intCountID As Integer
Dim intCountChecks As Integer
With rs
Do While Not .EOF
If intID <> .Fields(.Fields(0).Name) Then
intID = .Fields(.Fields(0).Name)
End If
intCountID = DCount("TableID", MyTable, "TableID = " & intID)
intCountChecks = DCount("Test", MyTable, "Test = True And TableID = " & intID)
If intCountID > 3 Then
If intCountChecks < 3 Then
.Edit
.Fields("Test") = True
.Update
End If
Else
.Edit
.Fields("Test") = True
.Update
End If
.MoveNext
Loop
.Close
End With
db.Close

strSQL = "DELETE * FROM " & MyTable & " WHERE Test = False;"

DoCmd.RunSQL strSQL

Set rs = Nothing
Set db = Nothing

End Function

Stewart

 

[SJMcAbney]

I forgot to say 'Add a field to your table, and make it a Yes/No field, defaulted to False'

Stewart

 

[Corwyn]

Thxs.
I've try it.
But my Access don't recognize the DAO property (DAO.database, DAO.recordset
Suggestion?

 

[SJMcAbney]

Open a module, go to Tools -> References

Select Microsoft DAO 3.6 Library

It should work now.

Stewart

 

[Corwyn]

You're great! It works fine, Thanks!

One more question (if I may): what do I have to change to work with text instead of numbers?

 

[SJMcAbney]

Same function but a few tweaks to work with a text field.


Public Function TidyMyData() As Boolean

Const MyTable As String = "Table1"

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(MyTable)
Dim strID As String
Dim intCountID As Integer
Dim intCountChecks As Integer
With rs
Do While Not .EOF
If intID <> .Fields(.Fields(0).Name) Then
intID = .Fields(.Fields(0).Name)
End If
intCountID = DCount("TableID", MyTable, "TableID = """ & strID & """")
intCountChecks = DCount("Test", MyTable, "Test = True And TableID = """ & strID & """")
If intCountID > 3 Then
If intCountChecks < 3 Then
.Edit
.Fields("Test") = True
.Update
End If
Else
.Edit
.Fields("Test") = True
.Update
End If
.MoveNext
Loop
.Close
End With
db.Close

strSQL = "DELETE * FROM " & MyTable & " WHERE Test = False;"

DoCmd.RunSQL strSQL

Set rs = Nothing
Set db = Nothing

End Function

Stewart

 

[Corwyn]

Doesn't work!
It run but it makes no deletion...

 

[SJMcAbney]

I see it:


Public Function TidyMyData() As Boolean

Const MyTable As String = "Query2"

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(MyTable)
Dim strID As String
Dim strSQl As String
Dim intCountID As Integer
Dim intCountChecks As Integer
With rs
Do While Not .EOF
If strID <> .Fields(.Fields(0).Name) Then
strID = .Fields(.Fields(0).Name)
End If
intCountID = DCount("TableID", MyTable, "TableID = """ & strID & """")
intCountChecks = DCount("Test", MyTable, "Test = True And TableID = """ & strID & """")
If intCountID > 3 Then
If intCountChecks < 3 Then
.Edit
.Fields("Test") = True
.Update
End If
Else
.Edit
.Fields("Test") = True
.Update
End If
.MoveNext
Loop
.Close
End With
db.Close

strSQl = "DELETE * FROM " & MyTable & " WHERE Test = False;"

DoCmd.RunSQL strSQl

Set rs = Nothing
Set db = Nothing

End Function

Stewart J. McAbney | Talk History

 

[Corwyn]

You're now officially my new best friend!
Thanks a lot, very much.

 

[SJMcAbney]

Not a problem.

Stewart J. McAbney | Talk History