Solved: Detecting / Avoiding Duplicates in a VBA userform.

[noxios]

Hi,

I’m trying to create an Excel VBA userform to manage some parking slots and I would need to verify if, on a specific date, a parking space is already attributed and/or if a specific car plate already has a place.

For that, I need a VBA routine that informs and prevents users from entering duplicate data.

When the user clicks on the insert button, the program should verify column C (date in text format). If the value (date) already exists, it should then verify column D (plate n°) and/or column E (parking n°); should any of these latter values match an existing record, the program should inform the user that the entry already exists and prevent him from inserting it.


id_____name________date_________plate n°___parking n°
1______Joao______02/10/2011______XXX______-1/009
2______Pedro_____03/11/2011______YYY______-1/010
3______Luis______02/10/2011______ZZZ______ -1/009
3______Pedro_____15/10/2011______XXX______-1/012


Thanks for your help!

[mancubus]

hi noxios...
you may play around with this code....


Dim ws As Worksheet
Dim StrRng1 As String, StrRng2 As String, StrRng3 As String, StrRng4 As String

'...
'...
'...

Set ws = Worksheets("Park_Data") 'change ws name to suit
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

StrRng1 = "'Park_Data'!C2:C" & LastRow 'change ws name to suit -- dates
StrRng2 = "'Park_Data'!D2:D" & LastRow 'change ws name to suit -- plates
StrRng3 = "'Park_Data'!E2:E" & LastRow 'change ws name to suit -- park no.s

'cboDate = Date
'cboPlate = String
'cboParking = Long

If Evaluate("SumProduct((" & StrRng1 & "=" & cboDate.Value & ")*(" & StrRng2 & _
"=""" & cboPlate.Text & """)*(" & StrRng3 & "=" & cboParking.Value & "))") _
> 0 Then
MsgBox "Dublicate entry", vbCritical, "WARNING"
Exit Sub
Else
With ws 'userform control values to ws cells...
.Cells(LastRow, 1).Value = Application.Max(.Range("A:A")) + 1 'record no - change to suit
.Cells(LastRow, 2).Value = txtName.Value 'Textbox1- change to suit
.Cells(LastRow, 3).Value = cboDate.Value 'Combobox1 - change to suit
.Cells(LastRow, 4).Value = cboPlate.Value 'Combobox2 - change to suit
.Cells(LastRow, 5).Value = cboParking.Value 'Combobox3 - change to suit
End With
End If

'...
'...
'...

[noxios]

Hi mancubus
1st... big thank you for trying to help me on this.

I tried to put this code in the file but, I can’t get no result maybe I'm doing something wrong :(

I'm putting the all file here if u can take a look on it will really help me

Name = TEST
Pass = 123

There are 2 *.xls files and they must remain together in same folder (they are the main program and a DB) the search is performed in a userform in the Cadastro.xls and it verify the existence of a previous record in Cadastro_Dados.xls

[mancubus]

which button checks the existence of a record? rechercher?

and in which worksheet is it expexted to find a match?

i can't see any entered data in worksheets?


ps: when uploading a file with macros to a website, make sure you disabled all codes which will effect the applications, suc as application.visible = false, kill xx.xls, close all workbooks save false, etc.

[noxios]

recherche = find but the search should be dun with the OK in the frmCadastro it’s the form used to insert new data (when ok is clicked).

The match is supposed to be found when u type new data in the frmCadastro form (by scanning the other Workbook Cadastro_Dados.xls before the OK is clicked or during the insertion of data in the form if possible)

The data is saved in the other workbook Cadastro_Dados.xls it's hide (just click unhide in tools bar to make it visible) to see data u should open it with the Cadastro.xls closed or else it doesn't open)

The program is made in two parts to be possible to work in the database from several places at same time in a network

you are correct next time I will unlock all before sending it

[mancubus]

if the records are stored in another workbook, you can try stg like this...


it seems parking no is also string. so i added an option for 1 date, 2 string data for evaluate

Dim ws As Worksheet
Dim StrRng1 As String, StrRng2 As String, StrRng3 As String, StrRng4 As String
Dim LastRow As Long

Set ws = Workbooks("Cadastro_Dados.xls").Worksheets("Parking") 'change ws name to suit
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
StrRng1 = "'[Cadastro_Dados.xls]Parking'!C2:C" & LastRow 'change ws name to suit -- dates
StrRng2 = "'[Cadastro_Dados.xls]Parking'!D2:D" & LastRow 'change ws name to suit -- plates
StrRng3 = "'[Cadastro_Dados.xls]Parking'!E2:E" & LastRow 'change ws name to suit -- park no.s

If Evaluate("SumProduct((" & StrRng1 & "=" & cboDate.Value & ")*(" & StrRng2 & "=""" & cboPlate.Text & """)*(" & StrRng3 & "=" & cboParking.Value & "))") > 0 Then
'If Evaluate("SumProduct((" & StrRng1 & "=" & cboDate.Value & ")*(" & StrRng2 & "=""" & cboPlate.Text & """)*(" & StrRng3 & "=""" & cboParking.Text & """))") > 0 Then

MsgBox "Dublicate entry", vbCritical, "WARNING"
Exit Sub
Else
With ws 'userform control values to ws cells...
.Cells(LastRow + 1, 1).Value = Application.Max(.Range("A:A")) + 1 'record no - change to suit
.Cells(LastRow + 1, 2).Value = txtName.Value 'Textbox1- change to suit
.Cells(LastRow + 1, 3).Value = cboDate.Value 'Combobox1 - change to suit
.Cells(LastRow + 1, 4).Value = cboPlate.Value 'Combobox2 - change to suit
.Cells(LastRow + 1, 5).Value = cboParking.Value 'Combobox3 - change to suit
End With
End If

[macropod]

Cross-posted at: http://www.tek-tips.com/viewthread.cfm?qid=1665441

For cross-posting etiquette, please read: http://www.excelguru.ca/node/7

[noxios]

mancubus a 1.000 thank you.


I will try this solution you posted and I’ll keep you informed of the result.

Maybe I can't reach a solution but your effort to solve my problem and to stick with me is living proofs that help across the net is possible.

Thank you!!!

[Aflatoon]

And here (http://www.ozgrid.com/forum/showthread.php?t=159644) it appears. None acknowledged as yet, that I can see.

[noxios]

Hi mancubus
No joy!!!... after several tests with the code and a little adaptation, it doesn't detect duplicity
Note: I put the code at the end of frmCadastro and a call command to it in the OK (to new record) and in the OK (to change record) no detection is made and duplicated records can be inserted with no info to the user :(

Any suggestion?

I tweaked a little the code because it added me 2 lines after each insertion like this:


Private Sub DuplicityDetection()

Dim ws As Worksheet
Dim StrRng1 As String, StrRng2 As String, StrRng3 As String, StrRng4 As String
Dim LastRow As Long

Set ws = Workbooks("Cadastro_Dados.xls").Worksheets("Parking") 'change ws name to suit
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
StrRng1 = "'[Cadastro_Dados.xls]Parking'!C2:C" & LastRow 'change ws name to suit -- dates
StrRng2 = "'[Cadastro_Dados.xls]Parking'!D2:D" & LastRow 'change ws name to suit -- plates
StrRng3 = "'[Cadastro_Dados.xls]Parking'!F2:E" & LastRow 'change ws name to suit -- park no.s

If Evaluate("SumProduct((" & StrRng1 & "=" & txtData.Value & ")*(" & StrRng2 & "=""" & txtMatricula1.Text & """)*(" & StrRng3 & "=" & cmbParking.Value & "))") > 0 Then
'If Evaluate("SumProduct((" & StrRng1 & "=" & txtDate.Value & ")*(" & StrRng2 & "=""" & txtPlate.Text & """)*(" & StrRng3 & "=""" & cmbParking.Text & """))") > 0 Then

MsgBox "Dublicate entry", vbCritical, "WARNING"
Exit Sub
Else
With ws 'userform control values to ws cells...
.Cells(LastRow + 1, 1).Value = Application.Max(.Range("A:A")) - 1 'record no - change to suit
.Cells(LastRow + 1, 2).Value = txtNome.Value 'Textbox1- change to suit
.Cells(LastRow + 1, 3).Value = txtData.Value 'Combobox1 - change to suit
.Cells(LastRow + 1, 4).Value = txtMatricula1.Value 'Combobox2 - change to suit
.Cells(LastRow + 1, 6).Value = cmbParking.Value 'Combobox3 - change to suit
End With
End If

End Sub

[mancubus]

please pay attention to macropod's and aflatoon's posts...

actually it's a piece of working code taken from one of my procedures that i used oftenly.

one possible reason is vba cannot evaluate date, as it uses "usa" date format.
another reason may be invalid use of quotes. reevaluate your data types.
it may be an option to record a macro for sumproduct.
write the sumproduct formula in a cell. start macro recorder, select cell, press F2 key and then enter. finally stop macro recorder. go to the vbe and examine the recorded macro.

[noxios]

Hi mancubus,

I seen the posts from both users you mention in your previous post.

Now related to your last answer
The all database is all text even the date and the ID I made like this because if I don't, when I make a insertion of data like “03/11/2011” it comes like this “ 3/11/2011” (it looses the 0 before the 3) and then when I search for date like “3/11/2011” it comes with this date but also with 13/11/2011 and also with 23/11/2011 and that’s not acceptable for me
that’s why I formatted all in DB as text

Hope you understand.

I will try format the columns as date and numbers to see if it's that the problem)

Thank you for your support and trying to get me a real solution.

[mancubus]

if all data are formatted as text then try:

If Evaluate("SumProduct((" & StrRng1 & "=""" & txtData.Text & """)*(" & StrRng2 & "=""" & txtMatricula1.Text & """)*(" & StrRng3 & "=""" & cmbParking.Text & """))") > 0 Then

[noxios]

Hi mancubus

I tested as you suggested today (also with this new line) and it didn’t fix the problem in this case the code doesn’t detect the duplicity

Question: where do you suggest I put the code???
My idea (based in the program that I posted in the forum) is put it after the OK (for new adding) button but it doesn't work.

Kind regards

[mancubus]

hi.

i'm on vacation and have limited access to internet.

that lines must be added to procedure which adds records to database.

when i run it from a separate macro, it worked for me.

[mancubus]

you may think of concatenating values that will be checked for duplication.

add a helper column as last column to your table. say, column 10.


Dim ws As Worksheet
Dim duplStr As String
Dim LastRow As Long

Set ws = Workbooks("Cadastro_Dados.xls").Worksheets("Parking")
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

duplStr = txtData.Text & txtMatricula1.Text & cmbParking.Text

If Application.CountIf(ws.Range("J2:J" & LastRow), duplStr) > 0 Then
MsgBox "Dublicate entry", vbCritical, "WARNING"
Exit Sub
Else
With ws
.Cells(LastRow + 1, 1).Value = Application.Max(.Range("A:A")) + 1
.Cells(LastRow + 1, 2).Value = txtNome.Value
.Cells(LastRow + 1, 3).Value = txtData.Value
.Cells(LastRow + 1, 4).Value = txtMatricula1.Value
.Cells(LastRow + 1, 6).Value = cmbParking.Value
.Cells(LastRow + 1, 10).Value = duplStr
End With
End If

[noxios]

Hi mancubus
Have a nice vacations ;-)

Meanwhile I’ll try this last approach that you posted.

Bye...for now :-D

[mdmackillop]

Hi Mancubus,
Re post 11; you can't use SumProduct directly in code, but you can use it with Evaluate.

[mancubus]

thanks mackillop.

i think i assumed the member would consider my previous posts regarding the use of sumproduct in vba...

[mancubus]

Hi mancubus
Have a nice vacations ;-)

Meanwhile I’ll try this last approach that you posted.

Bye...for now :-D

thanks noxios.
hope that helps...

[noxios]

Hi
This thread is almost finished, but I need a little more help.
mancubus please let me know when you are "around"

Thanks...

[noxios]

Sorry for not being clear mancubus.

Basically, the code would be perfect if I had to detect all three fields at one time (it detects if a given plate has been attributed a specific parking space on a given date).
Sub Duplicate()
Dim ws As Worksheet
Dim StrRng1 As String, StrRng2 As String, StrRng3 As String, StrRng4 As String
Dim LastRow As Long

Set ws = Workbooks("Cadastro_Dados.xls").Worksheets("Parking")
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
StrRng1 = "'[Cadastro_Dados.xls]Parking'!B2:B" & LastRow
StrRng2 = "'[Cadastro_Dados.xls]Parking'!E2:E" & LastRow
StrRng3 = "'[Cadastro_Dados.xls]Parking'!D2:D" & LastRow

If Evaluate("SumProduct((" & StrRng1 & "=""" & txtData.Text & """)*(" & StrRng2 & "=""" _
& txtMatricula1.Text & """)*(" & StrRng3 & "=""" & cmbParking.Text & """))") > 0 Then

MsgBox "Duplicate entry", vbCritical, "WARNING"
Set ws = Nothing
Exit Sub
Else
With ws
.Cells(LastRow + 1, 1).Value = Application.Max(.Range("A:A")) - 1
.Cells(LastRow + 1, 2).Value = txtData.Value
.Cells(LastRow + 1, 3).Value = txtNome.Value
.Cells(LastRow + 1, 4).Value = cmbParking.Value
.Cells(LastRow + 1, 5).Value = txtMatricula1.Value
End With
End If
End Sub

However I need to detect two situations:

1. On a specific date, the plate entered is already inserted (it doesn't matter which parking space it has; I only want to know that, on that day, that plate has 1 parking space attributed, whatsoever it is);



and / or


2. On a specific date, the parking space I am trying to attribute has already been attributed (it doesn't matter which car has the space; I only want to know that, on that day, that parking space is already occupied).


I hope I managed to explain what I need.


Thanks again for your help and patience...

[mancubus]

so you're changing your duplication rule to

Parking'!B2:B" & LastRow = cboDate AND Parking'!E2:E" & LastRow = txtMatricula1
OR
Parking'!B2:B" & LastRow = cboDate AND Parking'!D2: D" & LastRow = cmbParking

perhaps...

If Evaluate("SumProduct((" & StrRng1 & "=" & cboDate.Value & ")*(" & StrRng2 & _
"=""" & cboPlate.Text & """)+(" & StrRng1 & "=" & cboDate.Value & ")*(" & _
StrRng3 & "=""" & cboParking.Text & """))") > 0 Then
MsgBox "Dublicate entry", vbCritical, "WARNING"
Exit Sub
Else

[noxios]

Hi mancubus.,

It is simply brilliant... IT WORKS!!!

After a little adaptation in the routine, the result is perfect it detects now the two "double" possibilities independently or together.

However, there is one thing that does not work and I am sure you are able to help me. The routine does not stop when the duplicity is found (it saves a new line with a duplicity (even after inform me that is a duplicity).
I tried this:

MsgBox "Duplicate entry", vbCritical, "WARNING"
Set ws = Nothing
Exit Sub

But it doesn’t work.

Thanks again for your help and patience...

[mancubus]

must see final procedure...

what did you modify/add/delete?

if sumproduct evaluates to 0, the procedure adds new records.

[noxios]

Hi mancubus.

This is the routine as it is and working, does it help you to identify where the "problem" is?

Sub TestForDuplicate()
Dim ws As Worksheet
Dim StrRng1 As String, StrRng2 As String, StrRng3 As String, StrRng4 As String
Dim LastRow As Long

Set ws = Workbooks("Cadastro_Dados.xls").Worksheets("Parking")
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

StrRng1 = "'[Cadastro_Dados.xls]Parking'!B2:B" & LastRow
StrRng2 = "'[Cadastro_Dados.xls]Parking'!E2:E" & LastRow
StrRng3 = "'[Cadastro_Dados.xls]Parking'!D2:D" & LastRow

If Evaluate("SumProduct((" & StrRng1 & "=""" & txtData.Text & """)*(" & StrRng2 & _
"=""" & txtMatricula1.Text & """)+(" & StrRng1 & "=""" & txtData.Text & """)*(" & _
StrRng3 & "=""" & cmbParking.Text & """))") > 0 Then

MsgBox "Duplicate entry", vbCritical, "WARNING"
Set ws = Nothing
Exit Sub
Else
With ws
.Cells(LastRow + 1, 1).Value = Application.Max(.Range("A:A")) - 1
.Cells(LastRow + 1, 2).Value = txtData.Value
.Cells(LastRow + 1, 3).Value = txtNome.Value
.Cells(LastRow + 1, 4).Value = cmbParking.Value
.Cells(LastRow + 1, 5).Value = txtMatricula1.Value
End With
End If
End Sub

[mancubus]

not sure...
maybe because of string vs date...

my post: StrRng1 & "=" & cboDate.Value & ")*
your post: StrRng1 & "=""" & txtData.Text & """)*

try... if txtData containes date value
StrRng1 & "=" & txtData & ")*

[noxios]

The all database is all text even the date and the ID.
I made like this because if I do not, when I make an insertion of data like “03/11/2011” it comes like this “3/11/2011” (it looses the zero before the 3).
Then when I search for date like “3/11/2011”, it comes with this date but also with 13/11/2011 and also with 23/11/2011 and that is not acceptable for me that is why I formatted all in DB as text.

One more thing, this routine is called from another routine, so when I get out of this one the other continues entering the data
Is there any solution to break the other routine to continue after this one find duplicity?

[mancubus]

i recommend you first google "dates and times in vba." there are thousands of resources...

pls post a sample workbook (with already entered data and a one button userform that adds records to database -so include only one procedure for that single button.) to reproduce the same error.

i am too busy these days to deal with tens of procedures in the workbooks you posted in previous page.

ps: btw, if some other member will help, that's ok...

[noxios]

mancubus,


thanks once again for all the time and effort you’ve put into helping me; it was really appreciated.

For the administration: please close this thread as the initial problem has been solved.

[mancubus]

you're wellcome.

if your question(s) has been answered, mark the thread as solved from "thread tools" at the top; if not, just do nothing.