Randomly pick x people for cleaning duties. 1

[2manyerrors]

Hi all,

I've looked for random in the forums but can't seem to find anything related to what i'm doing. Hope someone can help me here.

My db has two tables. employee_table and employee_picked_table.

Ok, I have a small db that holds employees names. what I am trying to do is run a query or something where I can type in a number, let's say 5 and this will pull 5 random names from my employee table into a report to print. But, at the same time I would like the process to list the "randomly picked names" into a second table so I can print this if needed too. When the "randomly picked names" are listed in the second table, the dates and time stamp should be added too. This is so I can later run a report and list all the people who have been picked for cleaning duties by months.

The logic behind the db is pick random employees for clean up duties. I hope someone can help me solve this problem. Thank you a head of time!

 

[2manyerrors]

I forgot to add three things.

1. Employees must be a permanent employee. I have a field called status that have permanent, part_time.
2. Employees must not be disabled. I have a field called disabled, set to yes or no.
3. I'm using access 2003.

Thank you all.

 

[MajP]

Public Sub selectEmployeed()
  Dim strSql As String
  Dim TopX As String
  'have a form or something to get the number to select
  'For demo I use an input box. But not the best to validate your input
  TopX = InputBox("Enter Number to Select")
  If IsNumeric(TopX) Then
    strSql = "INSERT INTO employee_picked_table ( EmployeeID_FK, dtmSelected ) "
    strSql = strSql & "SELECT Top " & TopX
    strSql = strSql & " employee_table.EmployeeID, date() AS dtmSelected "
    strSql = strSql & "FROM employee_table "
    strSql = strSql & "WHERE (((employee_table.Status) = 'Permanent') And ((employee_table.Disabled) = False)) "
    strSql = strSql & "ORDER BY Rnd([EmployeeID])"
    'always debug so you can see if the sql is good
    Debug.Print strSql
    CurrentDb.Execute strSql
  End If
End Sub

You may have to change the names to meet your table names.
This pushes X into the employee_picked_Table. I assume you are not doing this more than onces a day. To show the ones just picked. Have a query where dtmSelected = date()

 

[2manyerrors]

I'm getting a lot of errors when I try to run my button. I'm quite lost. I don't know where to put the codes. I've tried to put it in a module and then in the button.

Can you take a look at my database to see if you can help me figure out what I am doing wrong? Thank you for any assistance.

 

[MajP]

Your problems were predominantly naming.

1. Inputbox is actaually a vb function that pops open an input box dialog form similar to a message box. So you can not call your textbox INPUTBOX. Since you built a form call the text box "txtBxInput".

2. As I said you have to make all the field and table names correct to match your field and table names. I changed the names. Remember, I was guessing since I did not see your tables. I changed to match.

3. Add a field to your employee picked table, "EmployeeID_FK", and make it a number field

Private Sub Toggle2_Click()
 Dim strSql As String
 Dim TopX As String
'have a form or something to get the number to select
'For demo I use an input box. But not the best to validate your input
 TopX = Me.txtBxInput
 If IsNumeric(TopX) Then
  strSql = "INSERT INTO employee_picked_table ( EmployeeID_FK, Date_Picked ) "
  strSql = strSql & "SELECT Top " & TopX
  strSql = strSql & " employee_table.ID, date() AS dtmSelected "
  strSql = strSql & "FROM employee_table "
  strSql = strSql & "WHERE (((employee_table.Status) = 'Permanent') And ((employee_table.Disable) = False)) "
  strSql = strSql & "ORDER BY Rnd([ID])"    'always debug so you can see if the sql is good
  Debug.Print strSql
  CurrentDb.Execute strSql
  MsgBox TopX & " Employees added for duty."
End If
End Sub

Now here is the biggest thing. You need to read up on relational database design. When you build databases you do not repeat data in multiple tables. You linked them in queries by Primary Key to Foreign Key.

Tbl picked should only have these fields.
pickedID (Primarykey autonumber)
employeeID_FK (foreign Key)
Date_Picked
Duty_Done
Duty_Notes

In the employee table each employee has an ID which uniquely identifies an employee. When you pick an employee then you only need to put that ID into the foreign key field "employeeID_FK". So every record in the picked table with a foreign key of 1 relates to Poule. In the query builder you draw a line from ID in employees table to EmployeeID_FK in the picked table, and then you can bring together the fields from both tables. You should spend some time learning about this before trying to build a database. If your background is spreadsheets, the paradigms are very different.
There is a ton of resources on the Web, here are some simple ones. Access comes with the Northwind sample db with lots of design demos.

http://www.databasedev.co.uk/table_design_tips.html

http://www.blueclaw-db.com/helpmicrosoftaccess.htm

http://www.ehow.com/how_13579_create-select-query.html

 

[2manyerrors]

Hi and thank you so much for helping me and being so informative!!

I did exactly what you said above. I've read much more on access and databases.

I got it to work but ran into a problem that I can't figure out. I've tested the form and it works fine but when I restart the database, it generates the same numbers.

For example, I choose five people then I close the database and choose another five people. Both sets of people are exactly the same. This would mean that the same five people will be choosen for duty everyday. I'm trying to get it to where different people get choosen every day. I've even changed the dates on my computer but still the same results. Hope you can help with this?

 

[MajP]

it is in the random function. It uses a key to set the random generator. So if the key is not reset, it starts over when the db closes.

change ..ORDER BY Rnd([ID]) to
ORDER BY Rnd([ID]*now())

It will take the employeeID and multiply by the current date time, which will give it a unique key whenever ran.

 

[Andrzejek]

Also, if you have 100 people to choose from, and you choose 5 for clean duty, wouldn't you have 95 people to choose from next day? You have to mark those 5 people in your DB so they will not be chosen again until all people had the honor of cleaning.

So your SQL would be something like:

INSERT INTO employee_picked_table ( EmployeeID_FK, Date_Picked ) 
SELECT Top 5
 employee_table.ID, date() AS dtmSelected 
FROM employee_table
WHERE (((employee_table.Status) = 'Permanent') 
And ((employee_table.Disable) = False)) [blue]
And employee_table.ID Not IN 
(Select employee_picked_table.EmployeeID_FK from employee_picked_table)[/blue]
ORDER BY Rnd([ID])

Code not tested.

Have fun.

---- Andy

 

[MajP]

That is probably a good assumption. My thought it was like drug testing where you can get picked again, just to keep people honest.

That would kind of work, but it probably needs to get more involved. Assume you only have 20 employees. After 5 months there is no one to draw from.

I think I would add a boolean "InPlay" field to the main table. As they are selected mark them as "InPlay" = false. Choose only those "inPlay". Once all are not "InPlay" run an update query to set all back "inPlay" = true.

 

[Andrzejek]

I was working under the assumption that everyone eventually will have to do some cleaning, but I don't want to pick on anybody. So if there are 10 people left (with 5 to pick), anyone has 50/50 chance of doing the cleaning. Last month there are only 5 people left, there is no picking, they are the cleaning crew.

Unless 2manyerrors has some other ways to do the picking.

Have fun.

---- Andy

 

[MajP]

Andy
Using your assumption it gets more complicated. Here is a solution. Assume you have 20 employees. You would pick five and get their IDs. Then insert into the picked table, and then tag them as not "inPlay". Now you have 15 available. So assume you only have 3 left in play and you want 5. It would pick the last 3 and assign them. Then put everyone back into play except the three assigned. Then pick the remaining 2. This allows you to cycle trough all available and then start assigning again. Your solution would only allow you to cycle once.

Private Sub Toggle2_Click()
  Dim strIDS As String
  Dim topX As Variant
  Dim available As Integer
  Dim assigned As Integer
  topX = Nz(Me.txtBxInput, 0)
  available = DCount("ID", "qryAvailable")
  MsgBox available
  If available = 0 Then
    CurrentDb.Execute "upQryMakeAllInPlay"
    available = DCount("ID", "qryAvailable")
  End If
  If IsNumeric(topX) And topX > 0 Then
    strIDS = getTopX_IDs(CInt(topX))
    If Not strIDS = "" Then
     assignCleaning (strIDS)
     removeFromPlay (strIDS)
    End If
    'if you did not have enough people to assign then
    'put all in play, then remove the just added from play and rerun
    If available < topX Then
       CurrentDb.Execute "upQryMakeAllInPlay"
       removeFromPlay (strIDS)
       strIDS = getTopX_IDs(topX - available)
       assignCleaning (strIDS)
       removeFromPlay (strIDS)
     End If
  End If
End Sub

Public Function getTopX_IDs(ByVal topX As Integer) As String
 Dim strSql As String
 Dim strIDS As String
 Dim rs As DAO.Recordset
 Dim recCount As Integer
'have a form or something to get the number to select
'For demo I use an input box. But not the best to validate your input
  strSql = strSql & "SELECT Top " & topX
  strSql = strSql & " ID "
  strSql = strSql & "FROM qryAvailable "
  MsgBox strSql
  Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
  If Not (rs.EOF And rs.BOF) Then
    rs.MoveLast
    rs.MoveFirst
  End If
  Do While Not rs.EOF
    If getTopX_IDs = "" Then
      getTopX_IDs = rs!ID
    Else
      getTopX_IDs = getTopX_IDs & "," & rs!ID
    End If
    rs.MoveNext
  Loop
  getTopX_IDs = getTopX_IDs
End Function

Public Sub assignCleaning(ByVal topX_IDs As String)
  Dim strSql As String
  Dim aIDS() As String
  Dim varID As Variant
  'MsgBox topX_IDs
  aIDS = Split(topX_IDs, ",")
  For Each varID In aIDS
    strSql = "INSERT INTO employee_picked_table (employeeID_FK,Date_Picked) VALUES (" & varID & ", #" & Date & "#)"
    CurrentDb.Execute strSql
  Next varID
End Sub

Public Sub removeFromPlay(ByVal topX_IDs As String)
  Dim strSql As String
  strSql = "UPDATE employee_table SET employee_table.inPlay = False WHERE employee_table.ID In (" & topX_IDs & ")"
  CurrentDb.Execute strSql
End Sub

qryAvailable

SELECT employee_table.ID, employee_table.Status, employee_table.Disable, employee_table.inPlay
FROM employee_table
WHERE (((employee_table.Status)="Permanent") AND ((employee_table.Disable)=False) AND ((employee_table.inPlay)=True))
ORDER BY Rnd([ID]*Now());

upQryMakeAllInPlay

UPDATE employee_table SET employee_table.inPlay = True;

 

[2manyerrors]

Hi guys. Thank you for you help.

I've changed the code to ORDER BY Rnd([ID]*now())

but still come up with the same results. I changed the system date and also the windows date but no luck.

Any other ideas? Please let me know.

 

[Andrzejek]

MayP, I agree - after everyone is picked, then all people should be back in rotation for cleaning joy.

But that points to another issue that I had mentioned before – the specifications for the program. We can assume what should happen, but it is up to the person who sets the rules of the logic – not to the programmer or the helpers – of how the program should work. In my work I question the rules, or lack of them, in the programs I write. If the user comes to me and says “give me the report that will help me with my work” – that’s not enough. I need rules, black and white, true or false. Not: sometimes, yes, but sometimes no, and I cannot say when this sometimes is.

The same goes here – how many people will you have to start with? How many will be picked every time? Do the people already picked will be part of the population for the next time or are they out of rotation until all people cleaned? If you have less people that you need to pick from, do you start with everybody or do you pick who you have left and then start with the rest of the people from the start? Do you include people on vacation / sick leave / jury duty / out of office / traveling / etc? And who knows what else should be addressed?

If these questions will be answered, the randomness of the program may not matter at all.

2manyerrors, some people say “Only God can make random selection”


Have fun.

---- Andy

 

[MajP]

Andy,
I was not trying to dictate a solution only demonstrating the possibilities. Mainly to show that the problem gets much harder to be able to cycle randomly through those who have not yet been chosen and reset after choosing all. Thats the usual "oh by the way..". Especially difficult to handle the case where there are 3 who have not yet been picked and you request 5. But yeah there are all kinds of strategies. In something like drug testing you may have a reduction policy where of those who have already been picked can be re-picked at a reduced probability. You could even have multiple probabilities based on some category.

 

[MajP]

Sorry I thought I fixed that. I could not find a simple solution. I added "Randomize" which is a function to clear the seed and it should have fixed this, but it did not. So this is my solution. There may be something easier, I need to investigate the original approach again. I may not be randomizing in the correct location

Build a very simple query.
qryAvailable

SELECT 
 employee_table.ID
FROM 
 employee_table
WHERE (((employee_table.Status)="Permanent") AND ((employee_table.Disable)=False))
ORDER BY employee_table.ID;

This is the IDs for all that are available.

Now add this function

Public Function getXRandomInRange(Xrequired As Integer, ByVal rangeTop As Integer) As Collection
  Dim x As Variant
  Dim colTemp As New Collection
  Dim tempX As Integer
  Dim inCollection As Boolean
  Dim intCount As Integer
  Randomize
  Do Until intCount = Xrequired
    inCollection = False
    tempX = Fix(Rnd() * rangeTop)
    For Each x In colTemp
      If x = tempX Then
        inCollection = True
        Exit For
      End If
    Next x
    If Not inCollection Then
      colTemp.Add (tempX)
      intCount = intCount + 1
    End If
  Loop
  Set getXRandomInRange = colTemp
End Function

If I want 5 employees and 20 available. It would return 5 values in the range from (0-19). And it is always a new set.

now add this

Private Sub AssignWithRepeats(topX As Integer)
 Dim strSql As String
 Dim available As Integer
 Dim topXs As Collection
 Dim x As Variant
 Dim rs As DAO.Recordset
 Dim intID As Integer
 available = DCount("ID", "qryAvailable")
 If topX > available Then
   MsgBox "There is not " & topX & " available"
 Else
   'this returns a collection with values from
   '0 to number of (avaialble - 1)
   Set rs = CurrentDb.OpenRecordset("qryAvailable")
   rs.MoveFirst
   Set topXs = getXRandomInRange(topX, available)
   For Each x In topXs
      rs.AbsolutePosition = x
      intID = rs!ID
      strSql = "INSERT INTO employee_picked_table ( EmployeeID_FK, Date_Picked ) "
      strSql = strSql & "VALUES ( " & intID & "," & Date & ")"
      Debug.Print strSql
      CurrentDb.Execute strSql
   Next x
    rs.Close
    Set rs = Nothing
 End If
End Sub

now change this

Private Sub Toggle2_Click()
  Dim topX As Integer
  If IsNumeric(Me.txtBxInput) Then
    topX = Nz(Me.txtBxInput)
    AssignWithRepeats topX
  End If
End Sub

 

[MajP]

before you do that. Try this. Add this function to a standard module

Public Function myRandom(id As Variant) As Double
  Randomize
  myRandom = Rnd(Now() + id)
End Function

before where you had
"ORDER BY Rnd([ID])"
replace with
"ORDER BY myRandom([ID])"

give that a try

 

[MajP]

after further reading the solution is to replace the query calls to rnd with the user defined function myRandom as per my last post.

 

[2manyerrors]

AAAAAAHHHHHHH... YAHHH!!!
That is perfect!!! Worked great!!
MajP you are a genuis!
Thank you sooo much for your help. Thank you, thank you. I feel so bad that I can not offer to help you in the way you help me. Thank you soooo much. I wish you and everyone who helped me solve this devious problem, a wonderful holiday season.

Thank you, thank you!!!

My goal was to make things as fair as possible kind of like drawing names out of a hat but into a database where we can actually manage and track things easier. Thank you soooo much!!

 

[MajP]

So what exactly are the rules to draw? Can those people who get picked in January be able to get picked in February? Or will you only draw from those who have not yet been picked?

Actually you have provided a lot of help. I learn as much or more than you by providing help. In the future I will know that the trick to get a random non repeating sequence is simply done by building a small user defined function that includes Randomize to reset the seed.

 

[2manyerrors]

It's simple. Every day right after lunch we have to post a list of people for clean up duty that occurs 1-2 hrs before lunch. The first person is the duty leader he/she gathers the rest to clean the bus and transport vans including trash can emptying, restroom and etc. This happens everyday. But we need to document it because sometimes they have to stay pass 5pm (end of work day) which generates overtime pay. If our bins needs to be shredded, then it takes a bit long to complete.

Every day a set of people will be listed. This could be 3 or 5 or 10 people depending on the duty.

Before, we used to just draw names and etc. But some people began to challenge the randomness of the name drawing when they continuously appear on the list. Realisticly drawing names is only fair if the person drawing names is. Plus if someone needs to leave then we document it into the database and keep track of who is not doing the cleaning duty. We needed a fair way of doing this so that people will not start disappearing in the last two hours or so of work for the daily cleaning duties.

Over-all, non-profit business so very low on the budget. I hope that answered your question.