Mark possible duplicates in Search

[George-Bowyer]

I have been given a spreadsheet of people who have attended past events held by the club using my db.

The available information is only FirstName and LastName and the event attended.


I want to add them to my tblEventAttendees table.


I have written the following code that will search my members list for someone with the correct FirstName LastName Combination and add the relevant PeopleID to the spreadsheet data.

    Dim DB As Database
    Dim RS1 As Recordset
    Dim RS2 As Recordset
    Dim strFirstName As String
    Dim strLastName As String
    Dim intPeopleID As Integer
    Dim strCriterion As String
    
    Set DB = CurrentDb()
    
    Set RS1 = DB.OpenRecordset("TrainingAttendanceFull", DB_OPEN_DYNASET)
    Set RS2 = DB.OpenRecordset("TblPeople", DB_OPEN_DYNASET)
    

    
    RS1.MoveFirst
    
        Do Until RS1.EOF
        
            strFirstName = RS1!Name
            strLastName = RS1!Surname
            
              
            strCriterion = "[fldFirstName] = '" & strFirstName & "' AND [fldLastName] = '" & strLastName & "'"
            
'            MsgBox strCriterion
            
                            
            RS2.FindFirst (strCriterion)
            
            If RS2.NoMatch Then
            
                RS1.MoveNext
                
            Else
            
                intPeopleID = RS2!PeopleID
    
    '            MsgBox intPeopleID
    
                RS1.Edit
                RS1!PeopleID = intPeopleID
                RS1.Update
                
                RS1.MoveNext
                
            End If
            
        Loop

However, if there are two or more matches, I would like it to leave RS1!PeopleID blank and check RS1!chkDuplicates

(Or even better, write all of the matching PeopleIDs into a different field)

Could anyone please help me with this last bit, please?

Many thanks.

George

 

[moke123]

Are there duplicates in tblPeople?

 

[George-Bowyer]

Possibly. It's not always easy to spot them, because the info is seldom exactly the same.

 

[MajP]

  Dim DB As Database
    Dim RS1 As Recordset
    Dim RS2 As Recordset
    Dim strFirstName As String
    Dim strLastName As String
    Dim intPeopleID As Integer
    Dim strCriterion As String
    dim strDupes as string
    
    Set DB = CurrentDb()
    
    Set RS1 = DB.OpenRecordset("TrainingAttendanceFull", DB_OPEN_DYNASET)
      
    RS1.MoveFirst
        Do Until RS1.EOF
            strFirstName = RS1!Name
            strLastName = RS1!Surname
            strCriterion = "[fldFirstName] = '" & strFirstName & "' AND [fldLastName] = '" & strLastName & "'"
            MsgBox strCriterion
            Set RS2 = DB.OpenRecordset("Select * from TblPeople where " & strCriterion, DB_OPEN_DYNASET)
            
            if not rs2.eof and rs2.Bof 'no match
              rs2.movelast
              rs2.moveFirst
              if rs2.recordcount = 1 ' one match
                rs1.edit
                RS1!PeopleID = RS2!PeopleID
                rs1.update
              else ' more than 1 
                do while not rs2.eof
                  if strDupes = "" then
                    strDupes = rs2!peopleID
                  else
                    strDupes = strDupes & ", " & rs2!peopleID
                  rs2.moveNext
                loop
                rs1.edit
                 rs1!DuplicateIDs = strDupes
                 rs!checkDuplicates = true
                rs1.update
              end if  
            End If
          rs1.movenext        
        Loop

 

[George-Bowyer]

Thanks

I can't get it to work yet, though.


I had to add two Thens and an End If to get it to compile. I think I put the End If in the right place.


It creates strCriteria as it should and then opens RS2 with a recordcount of 1 ok.


But it then doesn't trip the "If Not RS2.EOF And RS2.BOF Then" clause, so the code works the whole way through, but writes no PeopleIDs anywhere.

Dim DB As Database
Dim RS1 As Recordset
Dim RS2 As Recordset
Dim strFirstName As String
Dim strLastName As String
Dim intPeopleID As Integer
Dim strCriterion As String
Dim strDupes As String

Set DB = CurrentDb()

Set RS1 = DB.OpenRecordset("TrainingAttendanceFull", DB_OPEN_DYNASET)

RS1.MoveFirst

Do Until RS1.EOF
    strFirstName = RS1!Name
    strLastName = RS1!Surname
    strCriterion = "[fldFirstName] = '" & strFirstName & "' AND [fldLastName] = '" & strLastName & "'"
    MsgBox strCriterion ' WORKING FINE
    Set RS2 = DB.OpenRecordset("Select * from TblPeople where " & strCriterion, DB_OPEN_DYNASET)
    
    MsgBox RS2.RecordCount ' WORKING FINE
        
    If Not RS2.EOF And RS2.BOF Then 'no match ADDED THEN
        MsgBox "got here" 'THIS IS NOT GETTING TRIPPED
        RS2.MoveLast
        RS2.MoveFirst
        If RS2.RecordCount = 1 Then ' one match ADDED THEN
            MsgBox RS2!PeopleID
            RS1.Edit
            RS1!PeopleID = RS2!PeopleID
            RS1.Update
        Else ' more than 1
            Do While Not RS2.EOF
                If strDupes = "" Then
                    strDupes = RS2!PeopleID
                Else
                    strDupes = strDupes & ", " & RS2!PeopleID
                End If ' ADDED END IF HERE
                RS2.MoveNext
            Loop
            RS1.Edit
            RS1!DuplicateIDs = strDupes
            RS1!checkDuplicates = True
            RS1.Update
        End If
    End If
    RS1.MoveNext
Loop

It

 

[George-Bowyer]

Ah. Got it.

If Not RS2.EOF And NOT RS2.BOF Then


And I had to zerostring strDupes for the beginning of the next loop.


Many thanks.


George

 

[Gasman]

I don't believe you need to test for both?
If empty recordset, both are true?

SELECT Transactions.*, Transactions.ID
FROM Transactions
WHERE (((Transactions.ID)=0));

BOF True
EOF True

HTH

Ah. Got it.

If Not RS2.EOF And NOT RS2.BOF Then


And I had to zerostring strDupes for the beginning of the next loop.


Many thanks.


George

 

[MajP]

Sorry I wrote that in a rush without testing. Normally I write the check as

If Not (RS2.EOF And RS2.BOF) Then

But i forgot to write the parentheses

Almost always a recordset will open at the BOF with or without records in the recordset. So you really only need to see if it is at EOF for no records. However, in theory you could create a recordset with records in it and move to EOF. So the safe check for no records is to see it is at both the EOF and BOF which can absolutely only happen with no records.

Also for many types of recordsets you do not need to traverse (movelast, movefirst) to get the correct recordcount. I never remember in which cases you do and do not, so without testing I just threw it in.

 

[Pat Hartman]

Just FYI, you can't use single quotes when processing any name field that might include a single quote such as O'Brien. Change to using double quotes.

 

[George-Bowyer]

If Not (RS2.EOF And RS2.BOF) Then

But i forgot to write the parentheses

The parenthesis was my next guess, but the extra not seemed to do the trick ok.

Sorry I wrote that in a rush without testing.

Not at all. You saved me a massive amount of time manually checking 2000 records

It never would have occurred to me to create a small recordset with the search string rather then searching the larger one with it. I can think of a number of other places where that is going to help me.

I have always created all my recordsets from whole tables or queries at the beginning of a sub or function and then worked with them. Creating smaller ones on the fly seems obvious now that someone else has shown it to me

 

[George-Bowyer]

Just FYI, you can't use single quotes when processing any name field that might include a single quote such as O'Brien. Change to using double quotes.

Hmm. Yes. I had several O'Thises and O'Thats in my data. I had to edit the apostrophes out and then re-edit them back in again.

I thought that you had to use double quotes and single quotes together?

Would <<strCriterion = "[fldFirstName] = "" & strFirstName & "" AND [fldLastName] = "" & strLastName & """>> have worked?

 

[MajP]

Here is a good helper function that I use especially if doing a lot of SQL searches.

Public Function SQL_Text(ByVal varItem As Variant) As String
  If Not IsNull(varItem) Then
    varItem = Replace(varItem, "'", "''")
    SQL_Text = "'" & varItem & "'"
  Else
    SQL_Text = "Null"
  End If
End Function

You can then call it

strlastName = sqlText(rs1!LastName)

if you pass in O'brien it returns 'O''Brien' which is proper for sql
then you simply do

"lastName = " & strLastName

But this is better to handle other datatypes especially dates which will be properly returned in #MM/DD/YYYY#

' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
'   SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
'   SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
'   SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
'   SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
    ByVal Value As Variant) _
    As String

    Const vbLongLong    As Integer = 20
    Const SqlNull       As String = "Null"

    Dim Sql             As String
    Dim LongLong        As Integer

    #If Win32 Then
        LongLong = vbLongLong
    #End If
    #If Win64 Then
        LongLong = VBA.vbLongLong
    #End If

    Select Case VarType(Value)
        Case vbEmpty            '    0  Empty (uninitialized).
            Sql = SqlNull
        Case vbNull             '    1  Null (no valid data).
            Sql = SqlNull
        Case vbInteger          '    2  Integer.
            Sql = Str(Value)
        Case vbLong             '    3  Long integer.
            Sql = Str(Value)
        Case vbSingle           '    4  Single-precision floating-point number.
            Sql = Str(Value)
        Case vbDouble           '    5  Double-precision floating-point number.
            Sql = Str(Value)
        Case vbCurrency         '    6  Currency.
            Sql = Str(Value)
        Case vbDate             '    7  Date.
            Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
            If DateValue(Value) = Value Then
               Sql = Format$(Value, "\#mm\/dd\/yyyy\#")
            Else
               Sql = Format$(Value, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
            End If
        Case vbString           '    8  String.
            Sql = Replace(Trim(Value), "'", "''")
            If Sql = "" Then
                Sql = SqlNull
            Else
                Sql = " '" & Sql & "'"
            End If
        Case vbObject           '    9  Object.
            Sql = SqlNull
        Case vbError            '   10  Error.
            Sql = SqlNull
        Case vbBoolean          '   11  Boolean.
            Sql = Str(Abs(Value))
        Case vbVariant          '   12  Variant (used only with arrays of variants).
            Sql = SqlNull
        Case vbDataObject       '   13  A data access object.
            Sql = SqlNull
        Case vbDecimal          '   14  Decimal.
            Sql = Str(Value)
        Case vbByte             '   17  Byte.
            Sql = Str(Value)
        Case LongLong           '   20  LongLong integer (Valid on 64-bit platforms only).
            Sql = Str(Value)
        Case vbUserDefinedType  '   36  Variants that contain user-defined types.
            Sql = SqlNull
        Case vbArray            ' 8192  Array.
            Sql = SqlNull
        Case Else               '       Should not happen.
            Sql = SqlNull
    End Select

    CSql = Trim(Sql)

End Function