Prevent duplicate entries via userform

[tsweeney]

Ok, here is my issue. We have multiple people update our access database of client bank statements with the balances every month using an Excel frontend. The basic code below works fine and allows us to keep up with the administrative demands. But, there is nothing in place to prevent a duplicate entry from being made (i.e. If the balance for Client A is entered for September as $1000, there is no way to prevent the next person from entering the same account information.

The Excel frontend does have a sheet that changes a conditionally formatted cell at the time of entry, but I have seen several data points be double-entered.

My program has a sheet called "Contents of Access" which holds a straight dump of the data from access (because basically the rest of the office is good with Excel but never uses Access) which is updated every time the file is opened, so that contains all previously entered data.

So, to finish, an example of what I want is to have the userform below filled out and the program to catch if Acct #202020 has been updated for the month of April, allow the entry if it hasn't and block the entry if it has.

The attached code for cmdAdd is what runs when the Add button is pressed and the Push Table to Access runs on hitting close. I have disabled the red X with code to prevent possible errors from stopping halfway through.

If anyone can help with this, I will be ecstatic. This program has worked pretty well so far, but the double entry capability is something that I need to cut off.

So, thanks again!

Sub PushTableToAccess()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
    Dim i As Long, j As Long
    Dim Rw As Long
    
    Sheets("Data").Activate
    Rw = Range("A65536").End(xlUp).Row
    
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
    
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With

    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="tblAccounts", ActiveConnection:=cnn, _
             CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
             Options:=adCmdTable
    
    'Load all records from Excel to Access.
    For i = 2 To Rw
        rst.AddNew
        For j = 1 To 10
            rst(Cells(1, j).Value) = Cells(i, j).Value
        Next j
        rst.Update
    Next i
    
    ' Close the connection
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
 'clear records from the worksheet, leaving the headings
    Range("A1").CurrentRegion.Offset(1, 0).ClearContents

End Sub

Private Sub cmdAdd_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")

'find  first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row


'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtBusSec.Value
ws.Cells(iRow, 2).Value = Me.cboCapName.Value
ws.Cells(iRow, 3).Value = Me.txtCapNum.Value
ws.Cells(iRow, 4).Value = Me.cboAcct.Value
ws.Cells(iRow, 5).Value = Me.cboType.Value
ws.Cells(iRow, 6).Value = Me.txtClass.Value
ws.Cells(iRow, 7).Value = Me.cboMonth.Value
ws.Cells(iRow, 8).Value = Me.cboYear.Value
ws.Cells(iRow, 9).Value = Me.txtBalance.Value
ws.Cells(iRow, 10).Value = Me.txtBank.Value

Call Account

'clear the data
Me.cboCapName = ""
Me.txtCapNum.Value = ""
Me.txtBusSec.Value = ""
Me.cboAcct.Value = ""
Me.cboType.Value = ""
Me.txtClass.Value = ""
Me.cboMonth.Value = ""
Me.cboYear.Value = ""
Me.txtBalance.Value = ""
Me.txtBank.Value = ""
Me.cboCapName.SetFocus


End Sub

 

[Anthony47]

Two basic suggestions:
-you should populate the various listbox only with data that are eligible to be selected, ie are still open in your database
or
-before storing the information fed via the form (I imagine that is done by Call Account) you check that the entered position is missing in the existing data. You can do this by something like:

If Application.WorksheetFunction.Countif(Sheets("WhichSheet").Range("A:A"), WhichValueToCheckForNotDuplicate) >0 then
   MsgBox("Value " & WhichValueToCheckForNotDuplicate & " already exists in the database; cannot be entered again")
   Exit Sub
Else
   Call Account
End If
'your additional code

Hope this could be of any help.

Bye

 

[tsweeney]

Yes, it was helpful. I am working on this addition to my program. If I run into any issues, I will let you know. I have an idea for how I'll do it now, though.


Edit: Somehow I managed to post that without adding thank you!