Microsoft Access VBA - Identify Dups - not delete them 3

[charboy]

This is my first post and vba is something I dabble in so please excuse my ignorance.

I have a form which is to allow duplicate entries. Dups are defined as having the same pnbr and hic. I would like to provide the user with a message indicating which records are dups. I started by creating a table with the dups but I don't know how to get the values in the table into a message. If there's a better way, please let me know.

Private Sub HIC_Exit(Cancel As Integer)
  
  Const newTableName = "Tbl_Temp"
  Dim db As Database
  Dim strSql As String

  ' SQL string to create a new table
  strSql = "SELECT ID "
  strSql = strSql & "INTO [" & newTableName & "] "
  strSql = strSql & "FROM [Tbl_Entry]"
  strSql = strSql & " WHERE PNBR = '" & Me.PNBR & "'" & " AND HIC = '" & Me.HIC & "'"
    
  On Error Resume Next ' Delete table if it exists
  DoCmd.DeleteObject acTable, "Tbl_Temp"

  
  DoCmd.SetWarnings False
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings True
  
  db.Close

End Sub

 

[jrbarnett]

Use the BeforeUpdate event to detect existing entries rather than Exit, as it can be cancelled easily.

Private Sub HIC_BeforeUpdate (Cancel As Integer)

If DCount ("*", "[tbl_Entry]", "PNBR='" & me.pnbr & "' AND HIC='" & Me.HIC & "'") = 1 Then
  If Msgbox ("Duplicate value exists. Cancel?", vbYesNo+vbQuestion) = vbYes Then
    Cancel = True
  End If
End If

End Sub

John

 

[charboy]

That's a good start but it's not exactly what I wanted. I not only want to tell the user that the duplicate exists, I also want to tell the user which records are the duplicates. For example, the message would say something like 'Provider x hic x combination is already entered at record 16 and 304'.

Private Sub HIC_BeforeUpdate (Cancel As Integer)

If DCount ("*", "[tbl_Entry]", "PNBR='" & me.pnbr & "' AND HIC='" & Me.HIC & "'") > 1 Then
  If Msgbox ("Duplicate value exists. Cancel?", vbYesNo+vbQuestion) = vbYes Then
    Cancel = True
  End If
End If

End Sub

 

[ssatech]

How bout:
Private Sub HIC_Exit(Cancel As Integer)
Dim intAnswer As Integer
Dim Txttemp4 As Variant
Dim db As Database
Dim strSql As String
Const newTableName = "Tbl_Temp"


Txttemp4 = DLookup("[PNBR]", "Tbl_Entry", "[PNBR] = '" & Forms!Tbl_Entry!PNBR & "'")
If Not IsNull(Txttemp4) Then
GoTo PNBR
PNBR:
intAnswer = MsgBox("You already have a PNMBR " & [Txttemp4] & "." & Chr(13) & Chr(10) & "Would you like to allow this entry?", vbYes + vbQuestion, "Possible Duplicate")

strSql = "SELECT ID "
strSql = strSql & "INTO [" & newTableName & "] "
strSql = strSql & "FROM [Tbl_Entry]"
strSql = strSql & " WHERE PNBR = '" & Me.PNBR & "'" & " AND HIC = '" & Me.HIC & "'"

On Error Resume Next ' Delete table if it exists
DoCmd.DeleteObject acTable, "Tbl_Temp"


DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True

db.Close
End If

 

[charboy]

Again that's much appreciated but not exactly what I wanted. I not only want to tell the user that the duplicate exists, I also want to tell the user which records are the duplicates. For example, the message would say something like 'Provider x hic x combination is already entered at record 16 and 304'. That's why in the initial sql I used I pulled the ID variable (record indicator).

Your help is very much appreciated!

 

[PHV]

You wanted something like this ?
Dim dupID As Variant
dupID = DLookUp("ID", "Tbl_Entry", "PNBR='" & Me!PNBR & "' AND HIC='" & Me!HIC & "'")
If Not IsNull(dupID) Then
MsgBox "Provider " & Me!PNBR & " hic " & Me!HIC & " combination is already entered at record " & dupID
End If

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[stix4t2]

This is untested air code. It will test the count if greater than 1. If duplicates, it loops the records to build a string of ids, and reports them

Dim cntRecs As Variant
dim strRecs as string 
dim rec as recordset, strSql as string

'Get Count
cntRecs = DCount("*", "Tbl_Entry", "PNBR='" & Me!PNBR & "' AND HIC='" & Me!HIC & "'")
if( cntRecs > 1 ) then 'test if multiple
     'build sql
     strSql = Select ID from Tbl_Entry Where PNBR='" & Me!PNBR & "' AND HIC='" & Me!HIC & "'"
     set rec = db.openrecordset( strsql, dbsnapshot)
     'loop duplicates
     while(not rec.eof )
          strRecs = strRecs & iif( len(strRecs)>0, ", ", ""
          strRecs = strRecs & rec!id
          rec.movenext
     wend
     MsgBox "Provider " & Me!PNBR & " hic " & Me!HIC & " combination is already entered at record " & strRecs
     rec.close
end if

 

[charboy]

Thanks PHV,

That's closer to what I was hoping to do. The only problem is that it displays only the first duplicate ID and I suspect I'll have more than one sometimes. I would like the message to include all duplicates.

Thanks stix4t2,

I think you're code is really close. I had to make a few minor changes. I got the code to work down to...

Set rec = db.OpenRecordset(strSql, dbsnapshot)

...where I received an error which says...object required.

Private Sub HIC_Exit(Cancel As Integer)
Dim cntRecs As Variant
Dim strRecs As String
Dim rec As Recordset, strSql As String

'Get Count
cntRecs = DCount("*", "Tbl_Entry", "PNBR='" & Me!PNBR & "' AND HIC='" & Me!HIC & "'")
If (cntRecs > 1) Then  'test if multiple
     'build sql
strSql = "Select ID from Tbl_Entry Where PNBR='" & Me!PNBR & "'" & " AND HIC='" & Me!HIC & "'"
     Set rec = db.OpenRecordset(strSql, dbsnapshot)
     'loop duplicates
     While (Not rec.EOF)
          strRecs = strRecs & IIf(Len(strRecs) > 0, ", ", "")
          strRecs = strRecs & rec!ID
          rec.MoveNext
     Wend
     MsgBox "Provider " & Me!PNBR & " hic " & Me!HIC & " combination is already entered at record " & strRecs
     rec.Close
End If
End Sub

 

[Ascentient]

You need to Dimm your db as database.

 

[Ascentient]

Oops you need to Dimm and assign it to something.

 

[PHV]

Or replace this:
Set rec = db.OpenRecordset(strSql, dbsnapshot)
with this:
Set rec = CurrentDb.OpenRecordset(strSql, dbsnapshot)
As a safety measure, replace this:
Dim rec As Recordset
with this:
Dim rec As DAO.Recordset

And be sure that the Microsoft DAO 3.# Object Library is referenced (menu Tools -> References ...)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[charboy]

Thanks Ascentient and PHV.

I changed the two lines to:

Dim rec As DAO.Recordset
Set rec = CurrentDb.OpenRecordset(strSql,dbsnapshot)

but I am getting the following error...

run-time error '3001' - invalid argument...

Private Sub HIC_Exit(Cancel As Integer)
Dim cntRecs As Variant
Dim strRecs As String
Dim rec As DAO.Recordset, strSql As String

'Get Count
cntRecs = DCount("*", "Tbl_Entry", "PNBR='" & Me!PNBR & "' AND HIC='" & Me!HIC & "'")
If (cntRecs > 1) Then  'test if multiple
     'build sql
strSql = "Select ID from Tbl_Entry Where PNBR='" & Me.PNBR & "'" & " AND HIC='" & Me.HIC & "'"
 [red]Set rec = CurrentDb.OpenRecordset(strSql,dbsnapshot)[/red]
     'loop duplicates
     While (Not rec.EOF)
          strRecs = rec!ID
          strRecs = strRecs & IIf(Len(strRecs) > 0, ", ", "")
          strRecs = strRecs & rec!ID
          rec.MoveNext
     Wend
     MsgBox "Provider " & Me!PNBR & " hic " & Me!HIC & " combination is already entered at record " & strRecs
     rec.Close
End If
End Sub

I checked my references and Microsoft DAO 3.6 Object Library is checked.

I really appreciate your patience!

 

[Ascentient]

Try changing dbsnapshot to dbOpenDynaset or dbOpenForwardOnly since all we are looking for is duplicates. The latter of the two is probably your best choice.

 

[charboy]

That was it!!!

Thanks stix4t2 for the bulk of the code and Ascentient and PHV for cleaning it up!

 

[stix4t2]

charboy,

My fault, I am best described as 90% programmer. But the coding was pretty cool. Glad it worked for you.