Export UNIQUE rows to access with ADO

[durex]

So Im using the following method to export Excel records directly into
an Access database, where "FileID" is a primary key in the Database
table Im exporting to...


Code:
--------------------
Private Sub ExportMPM_Milestone(db)
Dim rs As Recordset, r As Long
Const strTableName As String = "tblMPM_Milestone"
Set rs = db.OpenRecordset(strTableName, dbOpenTable)
' get all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("C" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FileID") = Range("C" & r).Value
.Fields("WPID") = Range("B" & r).Value
.Fields("Name") = Left(Range("D" & r).Value, 40)
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
End Sub
--------------------



...the problem is, there are a few duplicate records for the FileID and
I want to only export the rows whose FileID (Column "C") is unique.

Ive found excel formulas on how to indentify unique records, but I
havent been able to figure out how to convert them to VBA code. Ive
also found VBA code to delete duplicate records, but I dont want to
modify the excel worksheet.

Any suggestions on the best / easiest way to do this?


Also, if its easy to do, I would like to keep track of each FileID
which is not imported because it is a duplicate so I can display a
message after the import is complete to the user of what records were
skipped.

Thanks a ton in advance!

 

[Tom Ogilvy]

Private Sub ExportMPM_Milestone(db)
Dim nodupes as New Collection
Dim bDup as Boolean
Dim rs As Recordset, r As Long
Const strTableName As String = "tblMPM_Milestone"
Set rs = db.OpenRecordset(strTableName, dbOpenTable)
' get all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("C" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
On Error Resume Next
Nodupes.Add Range("C" & r), cstr(range("C" & r))
if err.Number <> 0 then
err.Clear
bDup = True
' make a record of your r value
else
bDup = False
end if
if bDup = False then
.AddNew ' create a new record
' add values to each field in the record
.Fields("FileID") = Range("C" & r).Value
.Fields("WPID") = Range("B" & r).Value
.Fields("Name") = Left(Range("D" & r).Value, 40)
.Update ' stores the new record
End With
end with
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
End Sub

 

[Tom Ogilvy]

End With
end with

should be

End With
End If

--
Regards,
Tom Ogilvy

Private Sub ExportMPM_Milestone(db)
Dim nodupes as New Collection
Dim bDup as Boolean
Dim rs As Recordset, r As Long
Const strTableName As String = "tblMPM_Milestone"
Set rs = db.OpenRecordset(strTableName, dbOpenTable)
' get all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("C" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
On Error Resume Next
Nodupes.Add Range("C" & r), cstr(range("C" & r))
if err.Number <> 0 then
err.Clear
bDup = True
' make a record of your r value
else
bDup = False
end if
if bDup = False then
.AddNew ' create a new record
' add values to each field in the record
.Fields("FileID") = Range("C" & r).Value
.Fields("WPID") = Range("B" & r).Value
.Fields("Name") = Left(Range("D" & r).Value, 40)
.Update ' stores the new record
End With
end with
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
End Sub

 

[durex]

Awesome... thanks so much.