UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Help With Calendar Fill, Access 2010    
 
   
robbyaube2
post Feb 28 2018, 12:45 PM
Post#1



Posts: 11
Joined: 28-February 18



Hi folks,

I haven't been on here for a while but have come to a 8' thick brick wall with this function I have been trying to work with. My db is an employee management system that tracks leave requests, performance ect. One of the features I have for the leave requests is a calendar view which displays the month with the scheduled hours along with any leave request amount for a given day that month. The trouble I am having is that when I navigate from one month to the other the code is loading data from the month before or after depending on where the data resides... Here is the function that I adapted from a sample calendar years ago which I've been working with... I've also attached a screenshot so you can visualize what I'm working with. Thanks for any help you can provide!!

CODE
Public Function filldates(HasData As Boolean)
Dim curday As Variant, curbox As Integer, curdet As Integer
Dim SQL As String
Dim rst As dao.Recordset
Dim rstday As Date


Dim monHrs As String
Dim tuesHrs As String
Dim wedHrs As String
Dim thursHrs As String
Dim friHrs As String
Dim dayBox As String


curday = DateSerial(Year(Me![txtSetDate]), Month(Me![txtSetDate]), 1)
curday = DateAdd("D", 1 - Weekday(curday), curday)
Me.txtMonth_Year = Format(Me.txtSetDate, "mmmm") & " " & Year(Me.txtSetDate)


'Build the calendar
For curbox = 0 To 41
            
    Me("D" & curbox) = Day(curday)
    
    If Month(curday) = Month(Me!txtSetDate) Then
    
        Me("D" & curbox).Visible = True
        Me("DD" & curbox).Visible = True
        Me("DD" & curbox).RowSource = ""

    Else
    
        Me("D" & curbox).Visible = False
        Me("DD" & curbox).Visible = False
      
    End If

curday = curday + 1
Next curbox

'Fill the calendar
curbox = 1
curday = DateSerial(Year(Me![txtSetDate]), Month(Me![txtSetDate]), 1)
curday = DateAdd("D", 1 - Weekday(curday, vbMonday), curday)
Me.txtMonth_Year = Format(Me.txtSetDate, "mmmm") & " " & Year(Me.txtSetDate)

Select Case HasData
    Case True
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblAgentlHours WHERE empID = " & Me!txtEmpID & " AND WeekStarting BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By WeekStarting ASC")
    Case False
End Select
    
'Fill Shift dates
For curbox = 1 To 41 Step 7
    
    Select Case HasData
        Case True
            If rst.RecordCount > 0 Then
                rst.MoveFirst
                'rstday = rst!WeekStarting.Value
    
                Do While Not rst.EOF
                    
                    rstday = rst!WeekStarting.Value
                    
                    If rstday = curday Then
                    'If Day(rstday) = Day(curday) Then
                    'set values for Mon-Fri hrs in the current week being processed
                        monHrs = rst.Fields(3).Value
                        tuesHrs = rst.Fields(4).Value
                        wedHrs = rst.Fields(5).Value
                        thursHrs = rst.Fields(6).Value
                        friHrs = rst.Fields(7).Value
                        
                        dayBox = curbox
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & monHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & tuesHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & wedHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & thursHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & friHrs
                        dayBox = dayBox + 1
                    Else
                    End If
                    
                rst.MoveNext
                Loop
            End If
        Case False
    End Select
    
curday = curday + 7
Next curbox

'Fill Leave Dates
curbox = 1
curday = DateSerial(Year(Me![txtSetDate]), Month(Me![txtSetDate]), 1)
curday = DateAdd("D", 1 - Weekday(curday, vbMonday), curday)

'Set rst =         CurrentDb.OpenRecordset("SELECT * FROM tblAgentlHours WHERE empID = " & Me!txtEmpID & " AND WeekStarting BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By WeekStarting ASC")
Select Case HasData
    Case True
        Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblReq WHERE empID = " & Me!txtEmpID & " AND LeaveDate BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By LeaveDate ASC")
    Case False
End Select


For curbox = 1 To 41
    Select Case HasData
        Case True
            If rst.RecordCount > 0 Then
                rst.MoveFirst
                
                Do While Not rst.EOF
                    rstday = rst!LeaveDate.Value
                        
                    If rstday = curday Then
                    dayBox = curbox
                        Me("DD" & dayBox).AddItem rst!reqID & ";" & rst!totHrs
                    Else
                    End If
                
                rst.MoveNext
                Loop
            End If
        Case False
    End Select

curday = curday + 1
Next curbox

        
End Function


Attached File  CalView.png ( 22.26K )Number of downloads: 13
Go to the top of the page
 
projecttoday
post Mar 1 2018, 08:51 AM
Post#2


UtterAccess VIP
Posts: 9,703
Joined: 10-February 04
From: South Charleston, WV


You could make a copy of the database and change the names of the employees in the employees table and then post it.

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
robbyaube2
post Mar 1 2018, 12:59 PM
Post#3



Posts: 11
Joined: 28-February 18



Ok good idea, I will try to do that by sometime tomorrow.

Thanks!
Go to the top of the page
 
robbyaube2
post Mar 2 2018, 01:54 PM
Post#4



Posts: 11
Joined: 28-February 18



my file is more than 2mb so i'll have to try and strip it down a bit before attaching...
Go to the top of the page
 
robbyaube2
post Mar 6 2018, 12:24 PM
Post#5



Posts: 11
Joined: 28-February 18



it's quite a task getting this down to below 2mb I must say smile.gif, what I will do is separate the db into two separate mdb files and if you can take each and combine back into one it should work... mind you it's still stripped down to as small as I can get it.
Go to the top of the page
 
projecttoday
post Mar 6 2018, 12:26 PM
Post#6


UtterAccess VIP
Posts: 9,703
Joined: 10-February 04
From: South Charleston, WV


Have you compacted it?

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
robbyaube2
post Mar 6 2018, 12:42 PM
Post#7



Posts: 11
Joined: 28-February 18



Here are the files, part 1 has everything except the forms and part 2 has only the forms. Hopefully this works smile.gif

Attached File  EEManager___Part1.zip ( 190.74K )Number of downloads: 26

Attached File  EEManager___Copy___Part2.zip ( 361.1K )Number of downloads: 27
Go to the top of the page
 
robbyaube2
post Mar 6 2018, 12:43 PM
Post#8



Posts: 11
Joined: 28-February 18



I had compacted but didn't know I needed to zip them which would have solved that... oh well they're there now smile.gif

Thanks!!
Go to the top of the page
 
Peter Hibbs
post Mar 6 2018, 05:59 PM
Post#9


UtterAccess VIP
Posts: 1,496
Joined: 17-June 10
From: Dorset. UK.


Hi robby,

I think the reason for the problem is that you are creating the recordset at the start of the For/Next and then using the same data for every row on the calendar. What you should do is fetch the recordset data after every iteration of the For/Next loop like this :-
CODE
    For curbox = 1 To 41 Step 7
        Select Case HasData
            Case True
                Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblAgentlHours WHERE empID = " & Me!txtEmpID & " AND WeekStarting BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By WeekStarting ASC")
                If rst.RecordCount > 0 Then
  '                  rst.MoveFirst
                    Do While Not rst.EOF
                        rstday = rst!WeekStarting.Value
                        If rstday = curday Then

and probably for the holiday dates as well but I have not tested that. In this case you don't really need the rst.MoveFirst command since a new recordset always starts at the first row anyway.

HTH

Peter Hibbs.

Go to the top of the page
 
robbyaube2
post Mar 8 2018, 02:30 PM
Post#10



Posts: 11
Joined: 28-February 18



Hi,

Just tried this out.. it makes the function go quite slow (I assume because it needs to set a new recordset for each of the 48 iterations)... I don't know if it solve the issue since it seems to strip away the data once it finishes... im going to try again to step through it to confirm more... Let me know if anything pops out to you though.
Go to the top of the page
 
Peter Hibbs
post Mar 8 2018, 04:10 PM
Post#11


UtterAccess VIP
Posts: 1,496
Joined: 17-June 10
From: Dorset. UK.


Yes, you are correct (that is a very inefficient way of doing this).

The questions is - why do you need to use 42 List boxes to show a few numbers, why not just use 42 Text boxes instead which, I would think, would be a lot quicker?

Or better still, use a Continuous type form with just 7 Text boxes (one for each day) which would be even quicker (probably). See HERE for an example.

Peter Hibbs.
Go to the top of the page
 
robbyaube2
post Mar 12 2018, 01:52 PM
Post#12



Posts: 11
Joined: 28-February 18



The main reason I am using the list boxes, I used someone else's recommendation... I think the reason was that I needed to be able to double click an entry and have it open the event..

The initial system I used this one was an event scheduler so I had to be able to double click the event to be able to view the details and modify it if needed. I think I'd still have this need for this system so I can open a leave request to be able to modify it...

Go to the top of the page
 
Peter Hibbs
post Mar 12 2018, 04:56 PM
Post#13


UtterAccess VIP
Posts: 1,496
Joined: 17-June 10
From: Dorset. UK.


OK, fair enough - but you can do exactly that on the demo I mentioned. Did you try it?

Peter Hibbs.
Go to the top of the page
 
robbyaube2
post Apr 9 2018, 02:20 PM
Post#14



Posts: 11
Joined: 28-February 18



Hi sorry about that I will check out that demo asap. thanks!!
Go to the top of the page
 
robbyaube2
post Apr 10 2018, 11:51 AM
Post#15



Posts: 11
Joined: 28-February 18



tested out your calendar and it's great... it would take quite a bit of work to integrate it into my app but def an option..

I've worked a bit more on my original issue and it seems to stem from the value of "curday" from what I can see.

so I added the following code to make sure for weeks that overlap two months to grab the week in which I have data for...

This seems to reverse correctly for example when the first of the month falls on a Wednesday it will pull the week's schedule data from the week starting on the 30th of the month...

CODE
If WeekdayName(Weekday(curday), False) = "Sunday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Monday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Tuesday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Wednesday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "Thursday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "friday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "Saturday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
End If
Go to the top of the page
 
zaxbat
post Apr 10 2018, 12:27 PM
Post#16



Posts: 952
Joined: 26-January 06
From: .....the wiregrass (either you know or you don't)


Unless I'm missing something..you can replace this.....
CODE
If WeekdayName(Weekday(curday), False) = "Sunday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Monday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Tuesday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Wednesday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "Thursday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "friday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "Saturday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
End If

With this....
CODE
curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
If (Weekday(curday) >3) AND (Weekday(curday)< 7) then curday = curday -7


That said, I don't understand what you are doing with this....


(7 - 7 + 2) mod 7...... unless I am missing something....i swear it looks like this will always give you MONDAY....but I only had 1 cup of coffee today

And you can quickly get in trouble with dates when you do (date = date +/- myVAR) because that may move the date forward or backward into the next/previous week, month, or year and you have to catch that.
It looks like the work week has SAT & SUN in the middle of it somehow...is that right????
So...when the workweek goes into the next week or month you need to push it back in previous week for accountablility???? Maybe this is starting to make sense then....
This post has been edited by zaxbat: Apr 10 2018, 01:13 PM

--------------------
Kindest regards, and Cheers!
ZAX

A picture is worth a thousand words and a zipped DB is worth a thousand pictures.
Oh, and....please don't disappear into the Twilight Zone.... Holler back with your results!
Go to the top of the page
 
robbyaube2
post Apr 10 2018, 01:45 PM
Post#17



Posts: 11
Joined: 28-February 18



yeah the mods and 7's are just what came out when I was able to get things to semi work... I really didn't grasp the whole thing either...

Basically;

My schedules for each employee is one entry for a work week which is always on a Monday. It has a link to employee table with empID then has a week starting field and a field for mon, tues, wed, thurs, Friday in which I set how many hours they are scheduled for. This serves a few purposes. One it allows me to know how many total hours with all employees we have to calculate the allowable leave hours based one a set percentage. It also allows me to populate what the amount of hours they are scheduled for each work day in the calendar.

I have a set date variable which gives the current date based on the month chosen. From there I need to find the first Monday of that month. If the first Monday of that month is in such a position that there are days prior to it in the same month in the previous work week.. I need to move my recordset to the previous week which is the last week of the previous month (ei may 28, 2018).

The curday variable is used to query my table and establish the record set that will be run through to populate the calendar...

Here is the code in its entirety..

CODE
Public Function filldates(HasData As Boolean)
On Error GoTo ErrorHandler

Dim curday As Variant, curbox As Integer, curdet As Integer
Dim SQL As String
Dim rst As dao.Recordset
Dim rstday As Date


Dim monHrs As String
Dim tuesHrs As String
Dim wedHrs As String
Dim thursHrs As String
Dim friHrs As String
Dim dayBox As String


curday = DateSerial(Year(Me![txtSetDate]), Month(Me![txtSetDate]), 1)
curday = DateAdd("D", 1 - Weekday(curday), curday)
Me.txtMonth_Year = Format(Me.txtSetDate, "mmmm") & " " & Year(Me.txtSetDate)


'Build the calendar
For curbox = 0 To 41
            
    Me("D" & curbox) = Day(curday)
    
    If Month(curday) = Month(Me!txtSetDate) Then
    
        Me("D" & curbox).Visible = True
        Me("DD" & curbox).Visible = True
        Me("DD" & curbox).RowSource = ""

    Else
    
        Me("D" & curbox).Visible = False
        Me("DD" & curbox).Visible = False
      
    End If

curday = curday + 1
Next curbox

'Fill the calendar
curbox = 1
curday = DateSerial(Year(Me![txtSetDate]), Month(Me![txtSetDate]), 1)

'gives the day of the week of selected date MsgBox (WeekdayName(Weekday(curday), False))

If WeekdayName(Weekday(curday), False) = "Sunday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Monday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Tuesday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
ElseIf WeekdayName(Weekday(curday), False) = "Wednesday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "Thursday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "friday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
    curday = curday - 7
ElseIf WeekdayName(Weekday(curday), False) = "Saturday" Then
    curday = DateSerial(Year(curday), Month(curday), ((7 - Weekday(DateSerial(Year(curday), Month(curday), 7))) + 2) Mod 7)
End If



'curday = DateAdd("D", 1 - Weekday(curday, vbMonday), curday)
Me.txtMonth_Year = Format(Me.txtSetDate, "mmmm") & " " & Year(Me.txtSetDate)

Select Case HasData
    Case True

    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblAgentlHours WHERE empID = " & Me!txtEmpID & " AND WeekStarting BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By WeekStarting ASC")
    Case False
End Select
    
'Fill Shift dates
For curbox = 1 To 41 Step 7
    
    Select Case HasData
        Case True
            If rst.RecordCount > 0 Then
                rst.MoveFirst
                'rstday = rst!WeekStarting.Value
    
                Do While Not rst.EOF
                    
                    rstday = rst!WeekStarting.Value
                    
                    If rstday = curday Then
                    'If Day(rstday) = Day(curday) Then
                    'set values for Mon-Fri hrs in the current week being processed
                        monHrs = rst.Fields(3).Value
                        tuesHrs = rst.Fields(4).Value
                        wedHrs = rst.Fields(5).Value
                        thursHrs = rst.Fields(6).Value
                        friHrs = rst.Fields(7).Value
                        
                        dayBox = curbox
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & monHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & tuesHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & wedHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & thursHrs
                        dayBox = dayBox + 1
                        Me("DD" & dayBox).AddItem rst!hrsID & ";" & friHrs
                        dayBox = dayBox + 1
                    Else
                    End If
                    
                rst.MoveNext
                Loop
            End If
        Case False
    End Select
    
curday = curday + 7
Next curbox

'Fill Leave Dates
curbox = 1
curday = DateSerial(Year(Me![txtSetDate]), Month(Me![txtSetDate]), 1)
curday = DateAdd("D", 1 - Weekday(curday, vbMonday), curday)

'Set rst =         CurrentDb.OpenRecordset("SELECT * FROM tblAgentlHours WHERE empID = " & Me!txtEmpID & " AND WeekStarting BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By WeekStarting ASC")
Select Case HasData
    Case True
        Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblReq WHERE empID = " & Me!txtEmpID & " AND LeaveDate BETWEEN #" & curday & "# AND #" & curday + 40 & "# Order By LeaveDate ASC")
    Case False
End Select


For curbox = 1 To 41
    Select Case HasData
        Case True
            If rst.RecordCount > 0 Then
                rst.MoveFirst
                
                Do While Not rst.EOF
                    rstday = rst!LeaveDate.Value
                        
                    If rstday = curday Then
                    dayBox = curbox
                        Me("DD" & dayBox).AddItem rst!reqID & ";" & rst!totHrs
                    Else
                    End If
                
                rst.MoveNext
                Loop
            End If
        Case False
    End Select

curday = curday + 1
Next curbox

ErrorHandler:

      
End Function
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    24th June 2018 - 02:19 AM