[RESOLVED] Duplicate entry alert

[sujittalukder]

I am saving data to Access database via excel VBA through ADODB connection.
I have set Primary key for the field “Name of the person”. Now when a duplicate entry is being saved, it shows an error at line rs.update as Duplicate entry.
I want to put a message box alert through which user will be notified that the name is duplicate entry.
I used the following code:
On error goto endo:
‘
‘
Exit sub
Endo:
Msgbox “ Dupliate entry not allowed”
End sub

The problem is that for any type of error, it is showing the Msgbox “ Dupliate entry not allowed” so I want to make the code in such a way that this msgbox should appear only when there is a duplicate entry.

[VBFnewcomer]

The problem is that for any type of error, it is showing the Msgbox

obviously you should get the msgbox for every error because you designed it so!!!!! A better course would be
1.have a procedure level boolean variable (bNameExists) inside the saving routine and set it to True
2. send a query to find if the name exists if it does not exist then set the boolean to False

If bNameExists = False
   'do the saving
Else
  Msgbox "Duplicate Record"
   Exit sub
End if

Note however, Name should not be used for primary key a PK should always be unique. If you use name soon you'll run out of options

[sujittalukder]

Thanks for the reply

send a query to find if the name exists

But how can I do the same?

[VBFnewcomer]

something like this. Note this is not a VBA Code but VB6 you may have to make some adjustments to the syntax

Private Sub cmdSave_Click()
'conn is ADODB.Connection
'rsTemp is ADODB.Recordset
  Dim SQLtemp As String
  Dim bNameExists As Boolean
  bNameExists = True
    SQLtemp = "SELECT COUNT (*) FROM YOURTABLE WHERE NAME_OF_PERSON = '" & Me.Text1.Text & "'"
    Set rsTemp = conn.Execute(SQLtemp)
    If rsTemp.Fields(0).Value > 0 Then
      bNameExists = False
    End If
    If bNameExists = True Then
      MsgBox "Duplicate Entry"
      Exit Sub
    Else
      'continue with saving
    End If
End Sub

[sujittalukder]

Thaks for the support Modified to suit my needs and Its working

[VBFnewcomer]

Then do consider posting the modified code, it may help some one (meaning me ) in future.

[sujittalukder]

OK this is the final code I am using to check whether the name already exist or not. Please note that no Primary key has been assigned in Access database

Sub Datainput1()

Application.ScreenUpdating = False
Sheets("sheet1").Select
 If Sheets("sheet1").Range("A2").Value = "" Or Sheets("sheet1").Range("B2").Value = "" Then
    MsgBox "Blank entries cannot be saved"
    Range("A2").Select
    Exit Sub
 End If
 If Not IsNumeric(Sheets("sheet1").Range("B2").Value) Then
     MsgBox "Please enter valid amount."
     Range("B2").Select
     Exit Sub
 End If

Dim con As Object
Dim rs As New ADODB.Recordset
Dim bNameExists As Boolean
Set con = CreateObject("ADODB.Connection")
con.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\mydb.mdb"
With rs
        .ActiveConnection = con
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Source = "select * from table1"
        .Open
End With

bNameExists = True
a = Range("A2").Value
If rs.RecordCount > 0 Then
rs.MoveFirst
Else
With rs
.AddNew
.Fields("name") = Range("A2").Value
.Fields("amount") = Range("B2").Value
.Update
End With
Exit Sub
End If
Do
    If rs.Fields(0).Value = a Then
        MsgBox "Duplicate value"
        Range("A2").Select
        Exit Sub
    End If
rs.MoveNext
    If rs.EOF = True Then
        Exit Do
        End If
Loop
bNameExists = False
If bNameExists = False Then
With rs
.AddNew
.Fields("name") = Range("A2").Value
.Fields("amount") = Range("B2").Value
.Update
End With
End If
rs.Close
Set rs = Nothing
con.Close
Set con = Nothing
Sheets("sheet1").Rows(2).Select
Selection.ClearContents
Range("A2").Select
bNameExists = True
Application.ScreenUpdating = True
End Sub