hi folks,
im working in a homeless shelter and since i studied computers for a couple of years in college, rather foolishly said that i would design a piece of software to generate the rota for the shifts at work.
it turned out to be a load more complicated than i imagined.
can anyone out there lend a hand ?
i'll post what i have so far, its work in progress so its very messy and spagetti-like, but i think u get the general idea.
i tryed to use as many comments as i could as noone else that works with me here has any
VB experience.
again, any help or pointing out of stupid mistakes would be a big help.
************************************************** ******
Option Explicit
Private Sub cmdClear_Click()
Worksheets("Sheet1").Range("b2:o6").Clear ' command to clear the whole rota
End Sub
Private Sub cmdExit_Click()
End 'ends the program
End Sub
Private Sub cmdGo_Click()
Dim whichColumn As String ' var that shows the column to be deleted if the rota is incorrect
Dim whichCellString As String ' string which holds the position of the cell
Dim rowNumber As Integer ' int which feeds row position to whichCellString
Dim columnNumber As Integer ' int which feeds column pos to whichCellString
Dim randomNumber As Integer ' int which holds the random number
Dim careWorkerNumber As Integer 'Staff number
Dim careNumberShifts(6) As Integer ' Array which holds the number of shifts worked for each staff
Dim careNightShifts(6) As Integer ' Array which holds the number of night shifts done by each staff
Dim careOnDay As Integer ' checks that there is one careworker on duty (day)
Dim careOnNight As Integer ' checks there is a careworker on at night
Dim careWorkedLastNight(6) As Boolean ' checks that someone doing a 24 did not just finish a night shift
Dim outputString As String 'Holds the value to be placed in the cell
Dim hoursLooper As Integer ' shows hours worked
Dim hoursString As String ' holds cell reference
Dim hoursReset(6) As Integer ' used to hold the value in careNumberShifts in case the
Dim nightReset(6) As Integer ' columns do not follow the rules and need to be reset
Randomize ' command which allows random numbers to be generated
Worksheets("Sheet1").Range("b2:p6").Clear 'Clears previous rota
' FIRST LOOP, Columns
'******************************************
For columnNumber = 66 To 79 ' Unicode for letters "A" to "O"
'SECOND LOOP, Flag Checker
'**************************************
Do
careOnDay = 0 'allows a care worker to work that day shift
careOnNight = 0 'allows a care worker to work that night shift
whichColumn = Chr(columnNumber) & "2:" & Chr(columnNumber) & "6" 'move column left
Worksheets("Sheet1").Range(whichColumn).Clear 'clear selected column
'THIRD LOOP, Rows
'***********************************
For rowNumber = 2 To 6 ' Rows down
outputString = "Off"
careWorkerNumber = rowNumber ' your careworker number = the row number
hoursReset(careWorkerNumber) = careNumberShifts(careWorkerNumber)
nightReset(careWorkerNumber) = careNightShifts(careWorkerNumber)
randomNumber = Round(Rnd * 4 + 1) ' generates a random number between 1 and 4
Select Case randomNumber
Case 1 ' care worker day shift
outputString = "Day" 'adds 1 to shifts worked
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) + 1
'check to see if more than 10 shifts worked in the two weeks
If careNumberShifts(careWorkerNumber) > 10 Then
outputString = "Off" ' if hours full then give day off
careNumberShifts(careWorkerNumber) = 10
End If
'insure that only 1 care worker is on day shift
If careOnDay = 1 Then
outputString = "Off"
' take away shift
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) - 1
End If
If careNumberShifts(careWorkerNumber) < 10 Then
careOnDay = careOnDay + 1
End If
Case 2 ' care worker night shift
outputString = "Nite" ' adds 1 to shifts worked, and nights worked
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) + 1
' insure that care workers do not work a night shift before they do a 24
careWorkedLastNight(careWorkerNumber) = True
'check to see if more than 10 shifts worked in the two weeks
If careNumberShifts(careWorkerNumber) > 10 Then
outputString = "Off" ' if hours full, then give day off
careNumberShifts(careWorkerNumber) = 10
End If
careNightShifts(careWorkerNumber) = careNightShifts(careWorkerNumber) + 1
'Check number of nights worked
If careNightShifts(careWorkerNumber) > 4 Then
outputString = "Off" ' if more than 4 give day off
careNightShifts(careWorkerNumber) = 4
End If
'insure that only 1 care worker is on night shift
If careOnNight > 1 Then
outputString = "Off"
' take away shift
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) - 1
' take away night shift
careNightShifts(careWorkerNumber) = careNightShifts(careWorkerNumber) - 1
'GoTo jumpout
End If
If careNumberShifts(careWorkerNumber) < 10 And careNightShifts(careWorkerNumber) < 4 Then
careOnNight = careOnNight + 1
End If
Case 3 ' Care worker 24 Hour shift
outputString = "D/N" ' adds 2 to shifts worked, 1 to nights worked
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) + 2
' insure that care workers do not work a night shift before they do a 24
If careWorkedLastNight(careWorkerNumber) = True Then
outputString = "Off"
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) - 2
careWorkedLastNight(careWorkerNumber) = False
Else
careWorkedLastNight(careWorkerNumber) = True
End If
If careNumberShifts(careWorkerNumber) > 10 Then
outputString = "Off" ' if hours full, then give day off
careNumberShifts(careWorkerNumber) = 10
End If
careNightShifts(careWorkerNumber) = careNightShifts(careWorkerNumber) + 1
If careNightShifts(careWorkerNumber) > 4 Then
outputString = "Off" ' if more than 4 give day off
careNightShifts(careWorkerNumber) = 4
End If
'insure that only 1 care worker is on day or night shift
If careOnDay = 1 Or careOnNight = 1 Then
outputString = "Off"
' take away 2 shifts
careNumberShifts(careWorkerNumber) = careNumberShifts(careWorkerNumber) - 2
' take away night shift
careNightShifts(careWorkerNumber) = careNightShifts(careWorkerNumber) - 1
End If
If careNumberShifts(careWorkerNumber) < 10 And careNightShifts(careWorkerNumber) < 4 Then
careOnNight = careOnNight + 1
careOnDay = careOnDay + 1
End If
Case Is > 4
outputString = "Off" ' do i need this line ????
End Select
'jumpout:
whichCellString = Chr(columnNumber) & rowNumber
'Shows all the variable values at this stage
'MsgBox ("Cell =" & whichCellString & ", Random Number =" & randomNumber)
'MsgBox ("Shift = " & outputString)
'MsgBox ("Number shifts total =" & careNumberShifts(careWorkerNumber))
'MsgBox ("Nights Total =" & careNightShifts(careWorkerNumber))
'MsgBox ("Care On Day =" & careOnDay & ", Care on night =" & careOnNight)
With Worksheets("sheet1").Range(whichCellString)
.Value = outputString
.Font.Bold = True
End With
'Insure that there is at least 1 care worker on at all times
If rowNumber = 6 And careOnDay = 0 Then
rowNumber = 2
End If
If rowNumber = 6 And careOnNight = 0 Then
rowNumber = 2
End If
If careOnDay = 1 And careOnNight = 1 Then
Exit Do
End If
Next rowNumber 'next row down in column
For careWorkerNumber = 2 To 6
careNumberShifts(careWorkerNumber) = hoursReset(careWorkerNumber)
careNightShifts(careWorkerNumber) = nightReset(careWorkerNumber)
Next careWorkerNumber
Loop
For hoursLooper = 2 To 6
hoursString = Chr(80) & hoursLooper
Worksheets("sheet1").Range(hoursString).Value = careNumberShifts(hoursLooper)
Next hoursLooper
Next columnNumber
End Sub
************************************************** ****
any thoughts ?
"The Internet is flat i tell you, i'll stake my reputation on it..."
Help Designing a Shift Rota for work
