View Single Post
 
Old February 12th, 2005, 07:09 PM
Nurgle Nurgle is offline
Registered User
 
Join Date: Feb 2005
Location: Dublin, Drunk, Ireland.
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Help Designing a Shift Rota for work

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..."