Creating a randomly populated roster from a list

[Pete067]

Hi all,
I am a new user to Excel and would like to create a roster for work. I am a teacher and I need to allocate staff to Areas around the school for supervision. I have attached the roster outline with some random names and criteria for the roster. I feel that with some guidance in the right direction I could complete this roster. Ideally I would like a button that I can press that self generates this roster.
https://drive.google.com/file/d/1gnJsllLIyGpNh5tqyKZL6--mfZHe8Azm/view?usp=sharing
Thank you
Pete

 

[The_Macrotect]

Hi Pete,

Welcome to the forum, and to Excel! I'm going to give this a whirl, but need clarification on one of the conditions:

*Only allocate Doug, Mike, Wendy and Mark to Area 16 and 17

Do you exclusively want those staff members assigned to area 16 and 17 (nobody else can be assigned to 16 and 17)

or

Is it that Doug, Mike, Wendy, and Mark are only allowed to be assigned to those areas (no other areas are allowed for those staff members)


All the best,
Matt

 

[Pete067]

Hi Pete,

Welcome to the forum, and to Excel! I'm going to give this a whirl, but need clarification on one of the conditions:

*Only allocate Doug, Mike, Wendy and Mark to Area 16 and 17

Do you exclusively want those staff members assigned to area 16 and 17 (nobody else can be assigned to 16 and 17)

or

Is it that Doug, Mike, Wendy, and Mark are only allowed to be assigned to those areas (no other areas are allowed for those staff members)


All the best,
Matt

Hi Matt,

Thanks for helping me out!
Doug can only do 16 and 17. Mike, Wendy and Mark are the only staff that assist Doug in this Area, but can be also allocated to other Areas. In addition I will now need to close Area 4 on Monday and Tuesday.

Many thanks
Pete

 

[The_Macrotect]

Pete,

Although my method is probably laughable, I think it produces the results you want:

**Please try this on a copy of your worksheet and test extensively before running it on your original sheet - Always save your work before running the macro**

First, I set up a "helper" sheet called "Sheet2". If you already have a Sheet2, it will have to be called something else, and the code will have to be fixed accordingly. The sheet looks like this, and will have to be set up exactly like this for the code to work:

Excel 2007 32 bit

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Staff	Monday	Tuesday	Wednesday	Thursday	Friday	Area 1	Area 2	Area 3	Area 4	Area 5	Area 6	Area 7	Area 8	Area 9	Area 10	Area 11	Area 12	Area 13	Area 14	Area 15	Area 16	Area 17
2	Mary						X	X														X	X
3	John																					X	X
4	Joseph																					X	X
5	Marg																					X	X
6	Jenny	X	X	X																		X	X
7	Marie																					X	X
8	Matt																					X	X
9	Noah	X	X	X	X																	X	X
10	Jim																					X	X
11	Ben																					X	X
12	Sally																					X	X
13	Amy																					X	X
14	Larry																					X	X
15	Fred						X	X														X	X
16	Wendy
17	Mark
18	Mike
19	Doug						X	X	X	X	X	X	X	X	X	X	X	X	X	X	X

<tbody>
</tbody>

Sheet2
​

Column A lists all of the staff members. Row 1 lists conditions where staff members cannot work. Each condition should be filled in with an "X" in the appropriate cell.

Next, open your VBA editor by pressing Alt + F11 and paste the following code into a module:
(This is the laughable part - I'm sure someone else could have made this much cleaner )

Sub randomize_roster()
Dim randnum As Integer, staff As String, x As String, y As String, lastrow As Integer, areaval As Integer, dayval As Integer, ival As Integer, check As Integer, timeslooped As Integer, areacheck As Integer
Application.ScreenUpdating = False

Range("B3:F21").ClearContents

tryagain:
timeslooped = 0
dayval = 2
areaval = 22

lastrow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Activate

area16:
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area16
Else
Worksheets("Sheet1").Cells(20, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea16
Else: GoTo area16
End If
End If

endarea16:
dayval = 2
areaval = 23

area17:
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area17
Else
check = 20
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
GoTo area17
Else
End If
Worksheets("Sheet1").Cells(21, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea17
Else: GoTo area17
End If
End If

endarea17:
dayval = 2
areaval = 7


area1:
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
Sheets("Sheet2").Activate
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area1
Else
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area1
Else
End If
Next check

Select Case dayval
Case 1 To 2
Case 3
If Worksheets("Sheet1").Cells(3, 2).Value = staff Then
timeslooped = timeslooped + 1
GoTo area1
End If
Case 4
For areacheck = 2 To 3
If Worksheets("Sheet1").Cells(3, areacheck).Value = staff Then
timeslooped = timeslooped + 1
GoTo area1
End If
Next areacheck
Case 5
For areacheck = 2 To 4
If Worksheets("Sheet1").Cells(3, areacheck).Value = staff Then
timeslooped = timeslooped + 1
GoTo area1
End If
Next areacheck
Case 6
For areacheck = 2 To 5
If Worksheets("Sheet1").Cells(3, areacheck).Value = staff Then
timeslooped = timeslooped + 1
GoTo area1
End If
Next areacheck
End Select

Worksheets("Sheet1").Cells(3, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea1
Else: GoTo area1
End If
End If

endarea1:
dayval = 2
areaval = 8

area2:
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area2
Else
check = 3
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area2
Else
End If
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area2
Else
End If
Next check

Select Case dayval
Case 1 To 2
Case 3
If Worksheets("Sheet1").Cells(4, 2).Value = staff Then
timeslooped = timeslooped + 1
GoTo area2
End If
Case 4
For areacheck = 2 To 3
If Worksheets("Sheet1").Cells(4, areacheck).Value = staff Then
timeslooped = timeslooped + 1
GoTo area2
End If
Next areacheck
Case 5
For areacheck = 2 To 4
If Worksheets("Sheet1").Cells(4, areacheck).Value = staff Then
timeslooped = timeslooped + 1
GoTo area2
End If
Next areacheck
Case 6
For areacheck = 2 To 5
If Worksheets("Sheet1").Cells(4, areacheck).Value = staff Then
timeslooped = timeslooped + 1
GoTo area2
End If
Next areacheck
End Select








Worksheets("Sheet1").Cells(4, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea2
Else: GoTo area2
End If
End If

endarea2:
dayval = 2
areaval = 9

area3:
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area3
Else
For check = 3 To 4
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area3
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area3
Else
End If
Next check
Worksheets("Sheet1").Cells(6, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea3
Else: GoTo area3
End If
End If

endarea3:
dayval = 4
areaval = 10

area4:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area4
Else
For check = 3 To 6
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area4
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area4
Else
End If
Next check
Worksheets("Sheet1").Cells(7, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea4
Else: GoTo area4
End If
End If

endarea4:

dayval = 2
areaval = 11

area5:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area5
Else
For check = 3 To 7
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area5
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area5
Else
End If
Next check
Worksheets("Sheet1").Cells(8, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea5
Else: GoTo area5
End If
End If

endarea5:
dayval = 2
areaval = 12

area6:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area6
Else
For check = 3 To 8
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area6
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area6
Else
End If
Next check
Worksheets("Sheet1").Cells(9, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea6
Else: GoTo area6
End If
End If

endarea6:
dayval = 2
areaval = 13

area7:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area7
Else
For check = 3 To 9
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area7
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area7
Else
End If
Next check
Worksheets("Sheet1").Cells(10, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea7
Else: GoTo area7
End If
End If

endarea7:
dayval = 2
areaval = 14

area8:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area8
Else
For check = 3 To 10
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area8
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area8
Else
End If
Next check
Worksheets("Sheet1").Cells(11, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea8
Else: GoTo area8
End If
End If

endarea8:
dayval = 2
areaval = 15

area9:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area9
Else
For check = 3 To 11
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area9
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area9
Else
End If
Next check
Worksheets("Sheet1").Cells(13, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea9
Else: GoTo area9
End If
End If

endarea9:
dayval = 2
areaval = 16

area10:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area10
Else
For check = 3 To 13
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area10
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area10
Else
End If
Next check
Worksheets("Sheet1").Cells(14, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea10
Else: GoTo area10
End If
End If

endarea10:
dayval = 2
areaval = 17

area11:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area11
Else
For check = 3 To 14
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area11
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area11
Else
End If
Next check
Worksheets("Sheet1").Cells(15, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea11
Else: GoTo area11
End If
End If

endarea11:
dayval = 2
areaval = 18

area12:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area12
Else
For check = 3 To 15
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area12
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area12
Else
End If
Next check
Worksheets("Sheet1").Cells(16, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea12
Else: GoTo area12
End If
End If

endarea12:
dayval = 2
areaval = 19

area13:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area13
Else
For check = 3 To 16
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area13
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area13
Else
End If
Next check
Worksheets("Sheet1").Cells(17, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea13
Else: GoTo area13
End If
End If

endarea13:
dayval = 2
areaval = 20

area14:
If timeslooped > 12500 Then GoTo tryagain Else
randnum = Int((lastrow - 2 + 1) * Rnd + 2)
staff = Worksheets("Sheet2").Cells(randnum, 1).Value
x = WorksheetFunction.Index(ActiveWorkbook.Worksheets("Sheet2").Range(Cells(1, dayval), ActiveWorkbook.Worksheets("Sheet2").Cells(lastrow, dayval)), randnum, 0)
y = WorksheetFunction.Index(ActiveWorkbook.Sheets("Sheet2").Range(Cells(1, areaval), Worksheets("Sheet2").Cells(lastrow, areaval)), randnum, 0)
If x = "X" Or y = "X" Then
GoTo area14
Else
For check = 3 To 17
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area14
Else
End If
Next check
For check = 20 To 21
If Worksheets("Sheet1").Cells(check, dayval).Value = staff Then
timeslooped = timeslooped + 1
GoTo area14
Else
End If
Next check
Worksheets("Sheet1").Cells(18, dayval).Value = staff
dayval = dayval + 1
If dayval = 7 Then
GoTo endarea14
Else: GoTo area14
End If
End If

endarea14:


For Z = 2 To lastrow
staff = Cells(Z, 1).Value
ival = Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("B3:F21"), staff)
If ival < 1 Then
    dayval = 2
    areaval = 7
    GoTo area1
Else
End If
Next Z

Sheets("Sheet1").Activate
Application.ScreenUpdating = True
End Sub

Near the very end of the code (starting with "For Z=2 to lastrow" and ending with "Next Z") ensures that everyone gets on the schedule at least once. This can be taken out if that isn't necessary. (But it helps make sure that Noah doesn't miss out on his day.

Lastly, I put the following formula in cell J3 (next to Mary's name):

=COUNTIF($B$3:$F$21,I3)

Copy this down to the last staff member. This will tell you how many times they are on the schedule that week.

The result will give you something like this:

Excel 2007 32 bit

	A	B	C	D	E	F	G	H	I	J
1		Duty Roster
2		Monday	Tuesday	Wednesday	Thursday	Friday			Staff
3	Area 1	Joseph	Jim	Amy	Ben	Marg			Mary	5
4	Area 2	Marie	Matt	Sally	Larry	Jenny			John	5
5									Joseph	5
6	Area 3	Matt	Joseph	Matt	Jim	Jim			Marg	5
7	Area 4			Marg	Amy	Amy			Jenny	2
8	Area 5	Marg	Larry	Marie	Fred	John			Marie	5
9	Area 6	Fred	Amy	Jim	Matt	Larry			Matt	5
10	Area 7	Ben	Fred	Larry	Mary	Fred			Noah	1
11	Area 8	Mary	Marg	Fred	Mark	Matt			Jim	5
12									Ben	5
13	Area 9	Larry	Sally	John	Jenny	Marie			Sally	5
14	Area 10	John	John	Joseph	Sally	Ben			Amy	5
15	Area 11	Jim	Marie	Mike	Marie	Mary			Larry	5
16	Area 12	Amy	Ben	Mary	John	Noah			Fred	5
17	Area 13	Mark	Mary	Ben	Marg	Sally			Wendy	5
18	Area 14	Sally	Mike	Wendy	Joseph	Joseph			Mark	3
19									Mike	5
20	Area 16	Wendy	Doug	Mark	Mike	Wendy			Doug	2
21	Area 17	Mike	Wendy	Doug	Wendy	Mike

<tbody>
</tbody>

Sheet1​

Adding areas or changing the set-up of Sheet1 will cause errors in the code. Adding staff members, and changing around their work schedule should be fine though.

This should be as random as it gets, but certain staff members will pop up more frequently in a certain area depending on their availability. I should also mention that because of the size of the code, it may take a while to complete depending on computer speed. It took anywhere from about 2 - 30 seconds for me.

I hope this helps!


All the best,
Matt

 

[Pete067]

Thanks Matt!
I am grateful for your time and effort.
I haven't yet succeeded in running the code. My Mac keeps freezing when I do. I will try on a MS Windows computer as soon as I can and let you know if there is any difference.
Thanks again
Pete

 

[The_Macrotect]

Pete,

I’ve never used Excel for Mac, but from what I understand, there are some significant differences in the two versions, and that would effect the VBA needed. It works for me on a Windows computer, so please let me know how it goes.

Matt

 

[Pete067]

Thanks, that's good to know. I thought I was doing something wrong. I'll let you know when I've tested it.