GreenAcres,
I have a staffing database that tells whom is scheduled and what job
functions they will be doing for the day etc. on a rotation basis. It is
incomplete but I'm working on some kinks (Like after two weeks of running
schedules I'm getting a 1066 error I believe that says duplicate records even
though I have a bypass for it.)
I would be willing to share it but its pretty simple to do yourself as
follows.
Tables:
tbl_Emp
(This is employee names, ID's, day off number (1 = Sunday and Saturday = 7)
as well as the Job category that they fall under based on the third table
downs rules, last the shift they work (ie: 1, 2, 3)
tbl_Team_Day_Off
(this is the Day "1", and the team that would apply to (Sun)"A" and Day 4
(Wed.) team D) (I have my teams setup based on best to worst as follows:
A=Friday, B=Monday, C=Wednesday, D=Tuesday, E=Thursday) Saturday and Sunday
are not needed in my case as I dont work weekends period!) (For each one you
need a yes/no and select if day off or not)
tbl_Job_Functions
(Each Job function has a Job Category (Department Name or Department Code)
and a Job Function (This is the different positions I need to fill each day)
Now start building queries and linking your fields relationships and get the
data you want. I then made it a mktbl and started a table (Holding the names
and job function for a single day only) then changed it to an appndtbl for
future runs and testing)
This is where it gets tricky is the code to fix the duplicate date errors
etc. But here is my code to start with.. Like I said it has an error on
duplicates but I'm sure you can work it out. I'm on another project now an
djust have set this aside for a month or so. I'm in the proces of building a
sytem to track occurences from a time clock adn issue HR documents Auto as
well as issue write ups based on returning equipment habits. I may be close
to finishing but I have to work on it before i can fix these other things you
need...
Best of Luck
Kurt
--------------------------Module1 CODE
START-----------------------------------
Option Compare Database
Sub mcrSetupSchedule()
On Error GoTo errTest
Dim dbs As DAO.Database
Dim rstEMP As DAO.Recordset
Dim rstJOB As DAO.Recordset
Dim rstEmployeeAssignment As DAO.Recordset
Dim tbl As DAO.Recordset
Dim strEMP As String
Dim strJobCat As String
Dim strJobFun As String
Dim rstJobCat As DAO.Recordset
Dim dtmStart As Date
Dim dtmEnd As Date
Dim bytDayOff As Byte
dtmStart = Now() - 1
dtmEnd = #6/9/2006#
Set dbs = CurrentDb
Set rstEMP = dbs.OpenRecordset("SELECT DISTINCT Badge_Num, Job_Category,
Day_Off_Number, Shift " & _
"FROM tbl_Employee_Schedule;")
With rstEMP
.MoveFirst
Do Until .EOF
strEMP = .Fields("Badge_Num").Value
strJobCat = .Fields("Job_Category").Value
Set rstJobCat = dbs.OpenRecordset("SELECT Job_Function "
& _
"FROM
tbl_Job_Assignment_List " & _
"WHERE Job_Category='"
& strJobCat & "'")
rstJobCat.MoveFirst
Do Until rstJobCat.EOF
strJobFun = rstJobCat.Fields("Job_Function").Value
dtmStart = dtmStart + 1
bytDayOff = Weekday(dtmStart)
'1 skip Saturday and Sunday
'determine if weekday(dtmStart) = 1 then add 1
(Sunday)
'if weekday(dtmStart) = 7 then add 2 (Saturday)
If Weekday(dtmStart) = 1 Then 'Saturday or Sunday
dtmStart = dtmStart + 1
ElseIf Weekday(dtmStart) = 7 Then
dtmStart = dtmStart + 2
End If
If bytDayOff = .Fields("Day_Off_Number").Value Then
dtmStart = dtmStart + 1
End If
'2
'also ensure that no individual has duplicate Job
Functions for a given day and shift
' DoCmd.RunSQL "INSERT INTO tlnkEmployeeAssignment "
& _
' "VALUES(" & .Fields("Shift").Value &
",[" & strJobFun & " ],'" & dtmStart & "'," & strEMP & ")"
Set tbl = dbs.OpenRecordset("tlnkEmployeeAssignment",
dbOpenDynaset)
tbl.AddNew
tbl.Fields("Shift").Value = .Fields("Shift").Value
tbl.Fields("Badge_Num").Value = strEMP
tbl.Fields("Job_Function").Value = strJobFun
tbl.Fields("Date").Value = dtmStart
tbl.Update
Debug.Print .Fields("Shift").Value & ": " & strEMP &
": " & Format(DateAdd("d", i, dtmStart), "Short Date") & ": " & strJobCat &
": " & strJobFun
lala:
rstJobCat.MoveNext
Loop
.MoveNext
dtmStart = Now() - 1
Loop
End With
Exit Sub
errTest:
If Err.Number = 3021 Then 'no such record is found
Resume Next
ElseIf Err.Number = 3022 Then 'primary key violation
rstJobCat.MoveNext
strJobFun = rstJobCat.Fields("Job_Function").Value
Set tbl = dbs.OpenRecordset("tlnkEmployeeAssignment", dbOpenDynaset)
tbl.AddNew
tbl.Fields("Shift").Value = rstEMP.Fields("Shift").Value
tbl.Fields("Badge_Num").Value = strEMP
tbl.Fields("Job_Function").Value = strJobFun
tbl.Fields("Date").Value = dtmStart
tbl.Update
Debug.Print rstEMP.Fields("Shift").Value & ": " & strEMP & ": " &
Format(DateAdd("d", i, dtmStart), "Short Date") & ": " & strJobCat & ": " &
strJobFun
On Error GoTo errTest
GoTo lala
Else
MsgBox Err.Number & vbLf & Err.Description
'Resume
End If
End Sub