Stop Duplication with VBA in excel

[srogers]

Could someone please help. I have a userform that enables people to enter data in from drop down menus, at the same time they have to choose a date from the datepicker calander function. The spreadsheet where the information is stored is an unopened workbook plus the workbook where my userform is opened from. I need to stop people from entering duplicate entrys into the workbooks and give an error message to tell them the date has already been taken.

Basically they choose their name and shift they want to work (lates or early) from drop down menus and then choose the date when the shift is. If someone else has already taken the shift on that date then they get an error message back.

I hope this makes sense. I have tried to use the data validation method for this but it does'nt work when using code for some reason.

Many thanks to those who can help.

Simon

 

[HalfAce]

Hello Simon,

The spreadsheet where the information is stored is an unopened workbook plus the workbook where my userform is opened from.

This statement has me a little confused, but what comes to mind involves opening the workbook,
checking for duplicate dates/shifts and either allowing the entry or throwing up the message.

For what I'm thinking I'd need to know:
1) The names of the userform controls the users are entering the date and shift in.
2) The file path of the workbook to open. (Unless it's always going to be in the same folder
as the workbook that's opening it.)
3) The sheet name of the sheet your data (dates & shifts) are stored on.
4) The ranges of the dates & shifts to search for duplicates in.

 

[hayden]

Simon,
While I don't have a ton of time to answer you question I will suggest a few things. Write a script to open the unopened book when the userform is activated. (Search the board for the que to execute code when the userform is activated... I know it is here just not sure where).

Second you could write an if statement inside a loop that would check your value against the list of values already placed in the unopened book. Somthing like this

For i = 1 to lastvalue (or use a do loop or whatever)
cells(i,3).value = knownvalue
if myvalue = knownvalue then
Message box code to tell them to try again ( this is on the board too, and i can't remember it off the top of my head.)
Else if
End if
Next


This would loop through each known value from the unopened book and check it against the value the user is trying to enter. If they are equal it will pop up the message box saying please try again.

Otherwise it will just end.

Sorry I don't have the time to write the code for you, but maybe some one else will.

Good Luck

Hayden

 

[srogers]

Thanks guys for the input. I seem to have figured out how to stop duplication via the script below but it does not allow me to check two columns for duplicates. I have highlighted the IF statement that is supposed to choose two columns that must meet my criteria but it still only stops the date being duplicated and not the date and the shift. It doesn't seem to matter wether the DTPicker1 or cboShift is first, it still only blocks the date and not the shift.


Private Sub cmdOK_Click()
Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"C:\Book1.xls"
Range("A1").Select
Do
If WorksheetFunction.CountIf(Range("b1:b20"), cboShift.Value) > 1 And WorksheetFunction.CountIf(Range("c1:c20"), DTPicker1.Value) > 1 Then
MsgBox DTPicker1.Value & cboShift.Value & " already used"
GoTo Finish
End If
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = cboName.Value
ActiveCell.Offset(0, 1) = cboShift.Value
ActiveCell.Offset(0, 2) = DTPicker1.Value

Finish:
Range("A1").Select
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub

Any ideas, Thanks again.

 

[srogers]

Found the problem, in the following formula I should have put a > 0 instead of a > 1

If WorksheetFunction.CountIf(Range("b1:b20"), cboShift.Value) > 0 And WorksheetFunction.CountIf(Range("c1:c20"), DTPicker1.Value) > 0 Then
MsgBox DTPicker1.Value & cboShift.Value & " already used"
GoTo Finish
End If

Hope this helps someone else out.

 

[tusharm]

Three comments.

First, a technical one. I don't think you have solved your problem. Your test checks each column independently of the other. Consider the scenario where B1 contains "Early" C1 contains 10/15/2006, B2 contains "Late" and C2 contains 10/16/2006. With the code you shared, you cannot assign anyone to Late 10/15/2006 or Early 10/16/2006.

Second, a larger picture comment. Put yourself in the shoes of someone who has to use this UI. Essentially, you would have to play a guessing games as to what shift on what day is available. Let me try "Early 10/15." Not available. OK, how about early 10/16. Not available. OK, how about...you get the picture.

A much more friendly approach would be to show people what's available and let them pick what they want. XL -- a worksheet not a userform -- is ideally suited to show a grid with dates and shifts. You can also visually add other "blocked out" shifts. For example, if someone cannot work 2 consecutive shifts, you can block out the late shift on a given day if that person has picked the early shift but show the same shift as available to someone else.

Third and last comment. If multiple people will work with this concurrently, XL is the *wrong* way to go. Ideally, you should create a SQL/ODBC solution that lets you update a central database from a frontend that could be either in XL or even better IMO a website, possibly with a single page in it.

Found the problem, in the following formula I should have put a > 0 instead of a > 1

If WorksheetFunction.CountIf(Range("b1:b20"), cboShift.Value) > 0 And WorksheetFunction.CountIf(Range("c1:c20"), DTPicker1.Value) > 0 Then
MsgBox DTPicker1.Value & cboShift.Value & " already used"
GoTo Finish
End If

Hope this helps someone else out.