Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
| Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
  #1 (permalink)  
Old February 12th, 2005, 07:09 PM
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..."
  #2 (permalink)  
Old February 14th, 2005, 10:14 AM
Authorized User
 
Join Date: Oct 2004
Location: , , .
Posts: 60
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via AIM to shattered Send a message via Yahoo to shattered
Default

ooosh... well the first problem with this code is the Do / Loop - it opens but never ends?

each do / loop should have a method to exit

do until / loop
do / loop until

Although you do have an Exit Do in there, having run the code the two conditions never = 1 and it cycles indefinately..

randomNumber = Round(Rnd * 4 + 1) ' generates a random number between 1 and 4

no it doesn't, when you generate a random number like this the possible range will be 1 to 5, a better, but still not ideal method would be

(rnd() * 4)+1


Similar Threads
Thread Thread Starter Forum Replies Last Post
Disable the [SHIFT Key] on Startup ru1 Access 4 September 22nd, 2007 09:27 PM
Time Shift Logic !!! dpkbahuguna Beginning VB 6 3 August 31st, 2007 11:56 AM
shift from vb to c# noman77 .NET Framework 2.0 1 October 14th, 2004 08:15 AM
Shift + Enter OR Shift+Double-Click phungleon Access 2 May 20th, 2004 10:14 AM
Trapping the Shift key yossarian Beginning VB 6 2 July 7th, 2003 08:03 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.