Random Selection in Column w/ No Repetition in Row

P

peerogel

Board Regular
Joined
Jan 25, 2011
Messages
108
I need help creating a schedule that generates random selections with limited repetitions. The selections will go down the column with limited repetitions down the row. I thought I was on the right track but I'm stuck. https://www.mrexcel.com/forum/excel-questions/1064540-random-selection-repetition-rows.html

I was trying to figure the random selection thing and add from there, but cant figure out how to get the pre-assigned days off. I hoping I could skip the selection if the cell was not empty but that only ends the random selection for the row.

I hope I can get some guidance, im trying to make something like the table below. The x's represent the days off. Times would be how many times that item on the list has to be used on the column for the day. Thanks in advance.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Employee[/TD]
[TD]Sun[/TD]
[TD]Mon[/TD]
[TD]Tue[/TD]
[TD]Wed[/TD]
[TD]Thu[/TD]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD]Sun[/TD]
[TD]Mon[/TD]
[TD]Tue[/TD]
[TD]Wed[/TD]
[TD]Thu[/TD]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD][/TD]
[TD][/TD]
[TD]List[/TD]
[TD]Times[/TD]
[/TR]
[TR]
[TD]Employee1[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD]training[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L10[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]
Employee2​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L11[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee3​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L12[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]
Employee4​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L13[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee5​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]vacation[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L14[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]
Employee6​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L15[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]
Employee7​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]leave[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L16[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee8​
<strike></strike>[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L17[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]
Employee9​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L18[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee10​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L19[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]
Employee11​
<strike></strike>[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]L20[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee12​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]testing[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]TRA[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee13​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]WK[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]
Employee14​
<strike></strike>[/TD]
[TD]<strike></strike>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]SP[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Employees self-scheduling would be terribly time consuming and far more unfair (you'd have people pulling seniority and/or whining).
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Here's what the results look like for 13 Employees and 12 Tasks. In this case Each Day has 1 employee off (the Zeros).

[TABLE="width: 862"]
<colgroup><col><col><col span="12"></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]E1[/TD]
[TD]E2[/TD]
[TD]E3[/TD]
[TD]E4[/TD]
[TD]E5[/TD]
[TD]E6[/TD]
[TD]E7[/TD]
[TD]E8[/TD]
[TD]E9[/TD]
[TD]E10[/TD]
[TD]E11[/TD]
[TD]E12[/TD]
[TD]E13[/TD]
[/TR]
[TR]
[TD]2018-01-01- M[/TD]
[TD]0[/TD]
[TD]12[/TD]
[TD]10[/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD]11[/TD]
[TD]6[/TD]
[TD]9[/TD]
[TD]3[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]2018-01-02- T[/TD]
[TD]9[/TD]
[TD]0[/TD]
[TD]8[/TD]
[TD]6[/TD]
[TD]3[/TD]
[TD]11[/TD]
[TD]4[/TD]
[TD]10[/TD]
[TD]1[/TD]
[TD]5[/TD]
[TD]12[/TD]
[TD]7[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]2018-01-03- W[/TD]
[TD]7[/TD]
[TD]2[/TD]
[TD]0[/TD]
[TD]11[/TD]
[TD]10[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]3[/TD]
[TD]5[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]12[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]2018-01-04- Th[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]11[/TD]
[TD]0[/TD]
[TD]2[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD]9[/TD]
[TD]6[/TD]
[TD]10[/TD]
[TD]3[/TD]
[TD]8[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]2018-01-05- F[/TD]
[TD]10[/TD]
[TD]3[/TD]
[TD]1[/TD]
[TD]8[/TD]
[TD]0[/TD]
[TD]7[/TD]
[TD]11[/TD]
[TD]6[/TD]
[TD]4[/TD]
[TD]2[/TD]
[TD]12[/TD]
[TD]9[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]2018-01-06- S[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]12[/TD]
[TD]9[/TD]
[TD]6[/TD]
[TD]0[/TD]
[TD]5[/TD]
[TD]11[/TD]
[TD]8[/TD]
[TD]3[/TD]
[TD]10[/TD]
[TD]2[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]2018-01-07- S[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]4[/TD]
[TD]12[/TD]
[TD]1[/TD]
[TD]9[/TD]
[TD]0[/TD]
[TD]8[/TD]
[TD]3[/TD]
[TD]11[/TD]
[TD]2[/TD]
[TD]10[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]2018-01-08- M[/TD]
[TD]11[/TD]
[TD]10[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]8[/TD]
[TD]6[/TD]
[TD]12[/TD]
[TD]0[/TD]
[TD]2[/TD]
[TD]9[/TD]
[TD]7[/TD]
[TD]5[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]2018-01-09- T[/TD]
[TD]12[/TD]
[TD]7[/TD]
[TD]9[/TD]
[TD]5[/TD]
[TD]4[/TD]
[TD]10[/TD]
[TD]2[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]8[/TD]
[TD]11[/TD]
[TD]6[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]2018-01-10- W[/TD]
[TD]7[/TD]
[TD]1[/TD]
[TD]6[/TD]
[TD]10[/TD]
[TD]11[/TD]
[TD]3[/TD]
[TD]2[/TD]
[TD]12[/TD]
[TD]9[/TD]
[TD]0[/TD]
[TD]8[/TD]
[TD]5[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]2018-01-11- Th[/TD]
[TD]6[/TD]
[TD]11[/TD]
[TD]7[/TD]
[TD]3[/TD]
[TD]12[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]4[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]2018-01-12- F[/TD]
[TD]3[/TD]
[TD]8[/TD]
[TD]5[/TD]
[TD]7[/TD]
[TD]9[/TD]
[TD]2[/TD]
[TD]6[/TD]
[TD]4[/TD]
[TD]12[/TD]
[TD]10[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]2018-01-13- S[/TD]
[TD]2[/TD]
[TD]9[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD]3[/TD]
[TD]8[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]12[/TD]
[TD]6[/TD]
[TD]11[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]2018-01-14- S[/TD]
[TD]6[/TD]
[TD]3[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]0[/TD]
[TD]12[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]7[/TD]
[TD]4[/TD]
[TD]9[/TD]
[TD]8[/TD]
[TD]11[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Photomofo said:
Employees self-scheduling would be terribly time consuming and far more unfair (you'd have people pulling seniority and/or whining).
Click to expand...

You mean like flight attendants and pilots?
 
Upvote 0
Most of the facilities I've worked at have had around 100 people in operations. We've always used a Scheduler. I suspect Flight Attendants and Pilots also use Schedulers and/or work according to a fixed rotating schedule which is established a year ahead of time. An annual schedule works if the workflow is relatively steady, the workforce is stable and the complexity of the schedule is relatively low. It doesn't work in situations with less stability or more complexity - i.e. the military.

Having a scheduler doesn't preempt workers from doing trades.
 
Upvote 0
It's occurred to me the loops could be set up better.

For Task
For Employee

Set Boolean Flag to false

Do Until Flag = true

Randomly choose a Day_x between 1 and 14 (assuming a two week schedule)
Verify the employee isn't assigned a task that day and no other employee has that same task.

If the Verification is good you set Flag to true and exit loop

Loop

Next Employee
Next Task

This will fill in about 80 to 90% of your schedule and there won't be any double assigned tasks

Then you run a loop which verifies each date has all tasks assigned.
 
Last edited:
Upvote 0
This code is cleaner.

Code: 
Option Explicit


Sub Schedule()


Dim i As Integer
Dim Employee As Integer
Dim Task As Integer
Dim Day_x As Integer
Dim Schedule As Variant
Dim Loop_Count As Long
Dim Flag As Boolean


ThisWorkbook.Save


Schedule = Sheets("Schedule").Range("A1:N1000")


For Task = 1 To 12


    For Employee = 1 To 13
            
        Flag = False
        Loop_Count = 0
                        
        Do While Flag = False
                                  
            Flag = True
                
            'Assign a workday Randomly
            'Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)
            
            Day_x = Int((14 - 1 + 1) * Rnd + 1) + 1


            'Check for schedule conflict
                
            If Schedule(Day_x, Employee + 1) <> "" Then
                    
                Flag = False
                        
            End If
                
            'Check for task duplication
                
            If Flag = True Then
                
                For i = 1 To 12
                
                    If i = Employee Then
                    
                        i = i + 1
                            
                        If i = 13 Then
                        
                            Exit For
                            
                        End If
                        
                    End If
                
                    If Schedule(Day_x, i + 1) = Task Then
                    
                        Flag = False
                        Exit For
                    
                    End If
                
                Next i
                
            End If
            
            'If the Guess is good record the data
            
            If Flag = True Then
            
                Schedule(Day_x, Employee + 1) = Task
                
            End If
            
            
            Loop_Count = Loop_Count + 1
                
            'If the Logic isn't solving jump out of the loop
                
            If Loop_Count > 100000 Then
                
                Flag = True
                    
            End If
                                        
        Loop
    
    Next Employee
    
Next Task


'Verify task coverage


For Day_x = 1 To 14


    For Task = 1 To 12
    
        Flag = False
    
        For Employee = 1 To 13
    
            If Schedule(Day_x + 1, Employee + 1) = Task Then
            
                Flag = True
                Exit For
                
            End If
    
        Next Employee
        
        'This means the task wasn't assigned to this day
        
        If Flag = False Then
            
            For i = 1 To 13
        
                'Assign task to an empty spot in the schedule.
        
                If Schedule(Day_x + 1, i + 1) = "" Then
               
                    Schedule(Day_x + 1, i + 1) = Task
                    Flag = True
                    Exit For
                    
                End If
        
            Next i
        
            If Flag = False Then
            
                Sheets("Schedule").Range("A1:N1000") = Schedule
                MsgBox "Task not assigned."
                Stop


            End If
            
        End If
        
    Next Task


Next Day_x


Sheets("Schedule").Range("A1:N1000") = Schedule


End Sub
 
Upvote 0
Here's what the results look like.

[TABLE="width: 788"]
<colgroup><col><col><col span="12"></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]E1[/TD]
[TD]E2[/TD]
[TD]E3[/TD]
[TD]E4[/TD]
[TD]E5[/TD]
[TD]E6[/TD]
[TD]E7[/TD]
[TD]E8[/TD]
[TD]E9[/TD]
[TD]E10[/TD]
[TD]E11[/TD]
[TD]E12[/TD]
[TD]E13[/TD]
[/TR]
[TR]
[TD]2018-01-01 - M[/TD]
[TD]0[/TD]
[TD]6[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]1[/TD]
[TD]9[/TD]
[TD]8[/TD]
[TD]3[/TD]
[TD]7[/TD]
[TD]12[/TD]
[TD]10[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]2018-01-02 - T[/TD]
[TD]6[/TD]
[TD]0[/TD]
[TD]3[/TD]
[TD]5[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD]10[/TD]
[TD]9[/TD]
[TD]11[/TD]
[TD]12[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]2018-01-03 - W[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]12[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]11[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]2018-01-04 - Th[/TD]
[TD]10[/TD]
[TD]5[/TD]
[TD]11[/TD]
[TD]0[/TD]
[TD]12[/TD]
[TD]7[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]6[/TD]
[TD]1[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]2018-01-05 - F[/TD]
[TD]9[/TD]
[TD]12[/TD]
[TD]6[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]8[/TD]
[TD]10[/TD]
[TD]7[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]2018-01-06 - S[/TD]
[TD]12[/TD]
[TD]8[/TD]
[TD]7[/TD]
[TD]9[/TD]
[TD]11[/TD]
[TD]0[/TD]
[TD]3[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2018-01-07 - S[/TD]
[TD]4[/TD]
[TD]10[/TD]
[TD]8[/TD]
[TD]3[/TD]
[TD]7[/TD]
[TD]5[/TD]
[TD]0[/TD]
[TD]11[/TD]
[TD]6[/TD]
[TD]12[/TD]
[TD]1[/TD]
[TD]9[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]2018-01-08 - M[/TD]
[TD]7[/TD]
[TD]1[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]9[/TD]
[TD]10[/TD]
[TD]12[/TD]
[TD]0[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]8[/TD]
[TD]11[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]2018-01-09 - T[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]10[/TD]
[TD]8[/TD]
[TD]11[/TD]
[TD]12[/TD]
[TD]0[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]2018-01-10 - W[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]8[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]4[/TD]
[TD]9[/TD]
[TD]0[/TD]
[TD]11[/TD]
[TD]12[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2018-01-11- Th[/TD]
[TD]5[/TD]
[TD]4[/TD]
[TD]12[/TD]
[TD]11[/TD]
[TD]1[/TD]
[TD]9[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]10[/TD]
[TD]0[/TD]
[TD]2[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]2018-01-12 - F[/TD]
[TD]11[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]10[/TD]
[TD]8[/TD]
[TD]2[/TD]
[TD]1[/TD]
[TD]12[/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD]9[/TD]
[TD]0[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]2018-01-13 - S[/TD]
[TD]3[/TD]
[TD]8[/TD]
[TD]10[/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD]11[/TD]
[TD]12[/TD]
[TD]5[/TD]
[TD]1[/TD]
[TD]9[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]2018-01-14 - S[/TD]
[TD]2[/TD]
[TD]11[/TD]
[TD]9[/TD]
[TD]12[/TD]
[TD]0[/TD]
[TD]4[/TD]
[TD]8[/TD]
[TD]6[/TD]
[TD]10[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD]3[/TD]
[TD]5[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
One last version. Good luck.

Code: 
Option Explicit


Sub Schedule()


Dim i As Integer
Dim j As Integer
Dim Employee As Integer
Dim Task As Integer
Dim Day_x As Integer
Dim Schedule As Variant
Dim Loop_Count As Long
Dim Flag As Boolean


ThisWorkbook.Save


Schedule = Sheets("Schedule").Range("A1:N1000")


For Task = 1 To 12


    For Employee = 1 To 13
            
        Flag = False
        Loop_Count = 0
                        
        Do While Flag = False
                                  
            Flag = True
                
            'Assign a workday Randomly
            'Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)
            
            Day_x = Int((14 - 1 + 1) * Rnd + 1) + 1


            'Check for schedule conflict
                
            If Schedule(Day_x, Employee + 1) <> "" Then
                    
                Flag = False
                        
            End If
                
            'Check for task duplication
                
            If Flag = True Then
                
                For i = 1 To 12
                
                    If i = Employee Then
                    
                        i = i + 1
                            
                        If i = 13 Then
                        
                            Exit For
                            
                        End If
                        
                    End If
                
                    If Schedule(Day_x, i + 1) = Task Then
                    
                        Flag = False
                        Exit For
                    
                    End If
                
                Next i
                
            End If
            
            'If the Guess is good record the data
            
            If Flag = True Then
            
                Schedule(Day_x, Employee + 1) = Task
                
            End If
            
            
            Loop_Count = Loop_Count + 1
                
            'If the Logic isn't solving jump out of the loop
                
            If Loop_Count > 100000 Then
                
                Flag = True
                    
            End If
                                        
        Loop
    
    Next Employee
    
Next Task

'Post interim results here. It's helpful for debugging.


Sheets("Schedule").Range("A1:N1000") = Schedule


'Verify task coverage


For Day_x = 2 To 15


    For Task = 1 To 12
    
        Flag = False
    
        For Employee = 2 To 14
    
            If Schedule(Day_x, Employee) = Task Then
            
                Flag = True
                Exit For
                
            End If
    
        Next Employee
        
        'This means the task wasn't assigned to this day
        
        If Flag = False Then
            
            Loop_Count = 0
            
            Do While Flag = False
            
                'Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)
                'Randomize the way you look for an empty slot. If you move
                'right to left you'll end up getting more duplicates on the right side of the table.
            
                i = Int((14 - 2 + 1) * Rnd + 2)
                                
                'Find an empty spot in the schedule.
                                
                If Schedule(Day_x, i) = "" Then
                
                    If Loop_Count > 50000 Then
                
                        Schedule(Day_x, i) = Task
                        Flag = True
                    
                    Else
                    
                        For j = 2 To 14
                    
                            Flag = True
                    
                            If Schedule(Day_x, j) = Task Then
                            
                                Flag = False
                    
                            End If
                    
                        Next j
                        
                        If Flag = True Then
                        
                            Schedule(Day_x, i) = Task
                            Flag = True
                            
                        End If
                    
                    End If
        
                End If
                
                Loop_Count = Loop_Count + 1
                
                'If the Logic isn't solving jump out of the loop
                
                If Loop_Count > 100000 Then
                    
                    MsgBox "Task not assigned."
                    Stop
                    Exit Do
                        
                End If
        
            Loop
        
            If Flag = False Then


                MsgBox "Task not assigned."
                Stop


            End If
            
        End If
        
    Next Task


Next Day_x


Sheets("Schedule").Range("A1:N1000") = Schedule


End Sub
 
Last edited:
Upvote 0
Thank you. I'll play with the codes tomorrow, luckily its my days off. Seniority... YES, I hear it every day.. But I'm trying to make it a 'lil better for everyone.
 
Upvote 0
The trouble with this code is the people on far right of the matrix will tend to see more duplicate shifts on each schedule (2 to 3 vs 1 for everyone else). I worked on some logic that minimized duplicates but it was computationally expensive. It worked for 13 employees (4 minute calculation time) but it took over 10 minutes for 14 employees - I had the code set up to kick out after 10 minutes so I never got an answer.

We've always talked about semi-automating the scheduling task at my work so this was an interesting problem to work on.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Filter on decremental list
Replies
5
Views
94
Peter_SSs
Peter_SSs
A
  • Question Question
VBA help - Locking & unlocking on certain times of day
2
Replies
15
Views
327
dmt32
D
F
  • Solved
How to change value from data validation based on value in col A?
Replies
5
Views
332
Eric W
Eric W
N
  • Question Question
Adding to an existing MACRO
Replies
2
Views
103
Northern NY Design
N
J
  • Solved
Formula Filled Dates
Replies
4
Views
479
Fluff
Fluff

Forum statistics

Threads
1,223,884
Messages
6,175,174
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top