Question : How to make an automated roster using excel

i need to write a program that will automatically assign employees to specific work areas. i have no idea where to begin or how to accomplish this. There are three work areas. all employees can work in area 1 and 2 and only a few are able to work in area 3. Can someone help please

Answer : How to make an automated roster using excel

Hi..
Ok, I worked on it a little bit. I don't know what you want for sure, but here is a start that may be good enough.

All you need to do is put a list of all the employees that are allowed to work in area 3 in column B. All the rest of the employees go in column A (the ones that can only work in areas 1 and 2)

Then in E1, G1, and I1, put the number of employees you want for that area..see comments in those cells...

then run the macro "AssignEmployees" (ALT + F8)

The way it works...
It takes the number of employees allowed for area 3 (cell I3) from the list in column B at random and puts the random list in column H. Then any that is left over get added to the list in colomn A (internally, not on the sheet so your employee list will not be effected). Now from that list the number of employees in G1 get put in In the area 2 column (F) and removed from the list, then from the list of employees that are left, the number in E1 is the number of employees that get taken from the list and put in column D (area 1)...it's really quite simple...just have a look at the file I uploaded...I will also post the code...

It might be another day or 2 before I get back, but if this isn't what you want, or you need something different or have questions...let me know...

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:

           
           
             Sub AssignEmployees()
Dim EmpCol As New Collection
'Dim col_12 As New Collection
Dim MyRand As Integer
Dim Empl As String
Dim count1 As Integer
Dim count2 As Integer
Dim count3 As Integer
Dim r As Range
Dim n As Integer
Dim msg As Integer
 
 
    Range("D2:H2000").ClearContents
 
count1 = Range("E1").Value
count2 = Range("G1").Value
count3 = Range("I1").Value
 
 
'Add all area 3 employees to collection
Set r = Range("B2")
Do Until r.Value = ""
    EmpCol.Add r.Value
    Set r = r.Offset(1, 0)
Loop
 
If EmpCol.Count < count3 Then
    msg = MsgBox("You do not have enough employees listed for area 3 to assign the number you want to that area.  Add more employees to the list of allowed employees in area 3, or reduce the number in cell I1 you want in that area", vbOKOnly + 64, "")
    Exit Sub
End If
 
 
 
'Pick out however many employees is allowed for Area 3(from I1) and randomly put
'in column H and remove that employee from collection
Set r = Range("H2")
Do Until n = count3
        Randomize
        MyRand = Int((EmpCol.Count * Rnd) + 1)
        r.Value = EmpCol(MyRand)
        EmpCol.Remove (MyRand)
        Set r = r.Offset(1, 0)
        n = n + 1
Loop
n = 0
 
'Add rest of employees to collection from column A
Set r = Range("A2")
Do Until r.Value = ""
    EmpCol.Add r.Value
    Set r = r.Offset(1, 0)
Loop
    
        
 
If EmpCol.Count < count2 Then
    msg = MsgBox("There are not enough employees left over after area 3 to assign the number that you want to area 2.  Add more employess to either list, or reduce the number you want in area 2, (cell G1)", vbOKOnly + 64, "")
    Exit Sub
End If
 
 
'Pick out however many employees is allowed for Area 2(from G1) and randomly put
'in column F and remove that employee from collection
Set r = Range("F2")
Do Until n = count2
        Randomize
        MyRand = Int((EmpCol.Count * Rnd) + 1)
        r.Value = EmpCol(MyRand)
        EmpCol.Remove (MyRand)
        Set r = r.Offset(1, 0)
        n = n + 1
Loop
n = 0
 
        
If EmpCol.Count < count1 Then
    msg = MsgBox("There are not enough employees left over after area 2 " & _
     "and 3 to assign the number that you want to area 1.  Add more employess to " & _
       "either list, or reduce the number you want in area 1, (cell E1).  The employees that" & _
        " are left will be listed in area 1 now.", vbOKOnly + 64, "")
End If
 
 
'Pick out however many employees is allowed for Area 1(from E1) and randomly put
'in column D and remove that employee from collection
Set r = Range("D2")
On Error GoTo done
 
Do Until n = count1
        Randomize
        MyRand = Int((EmpCol.Count * Rnd) + 1)
        r.Value = EmpCol(MyRand)
        EmpCol.Remove (MyRand)
        Set r = r.Offset(1, 0)
        n = n + 1
Loop
        
done:
Exit Sub
 
End Sub
 
Sub ClearAssignedAreas()
    Range("D2:H2000").ClearContents
End Sub
           
         

Open in New Window

Select All

Ares1-2-and-3.xls (37 KB) (File Type Details)

First test