Tell me what dhpreviousworkdaya is and maybe I can give you some pointers.
If it is a function, post the code for it, please.
--
Dave Hargis, Microsoft Access MVP
NeoFax said:
I would rewrite that code as a public function in a standard module and use
the function as the control source for the text boxes. In the function test
to see if the reporting month has the correct number of days. You will need
that for 29-31 to allow for leap years as well. You can determine the last
day of a given month with this formula:
dateserial(year(date),month(date) + 1, 0)
It will return the date of the last day of the month for the date used..
--
Dave Hargis, Microsoft Access MVP
:
Currently I have a report that is generated from a crosstab query that
shows the accumulated hours from the previous day. This report has a
layout like:
Station W/C 1 2 3 4 5 6 7 8 9 10.....29 30 31 Total
1sta Ele 5 6 7 8 9 1 0 1 2 3 ....4 5 6 57
....
Total
Diff
The problem is months that do not have 31 total days. I receive an
error as the expression does not take into account the month's that do
not have 31 days. Here is the code for day 31:
=IIf(Weekday(CDate(Month(dhpreviousworkdaya(Now())) & "/" & "31" &"/"
& Year(dhpreviousworkdaya(Now()))),2)>5,[txtDf30],IIf(Not
IsNull(DLookUp("[holidate]","tblHolidays","[holidate] = #" &
CDate(Month(dhpreviousworkdaya(Now())) & "/" & "31" & "/" &
Year(dhpreviousworkdaya(Now()))) & "#")),[txtDf30],([txtDf30]+
[DailyAVG])-nz(Sum([31]),0)))
I would like to either A) do something like case select in the
expression(maybe an array) or B) write code that puts the info in 31
unbound boxes. However, I would like to use the one that is the
fastest as the report currently takes approximately 1 minute to open..- Hide quoted text -
- Show quoted text -
Rewrite as a public function, as in take the code I have and write it
in modules using Public Function blaBla(di as string, duh as date)?
If so, I have never done this. Thanks! I will research this and try
it out.- Hide quoted text -
- Show quoted text -
Here is the whole function:
Public Function dhAddWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
' Add the specified number of work days to the
' specified date.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' In:
' lngDays:
' Number of work days to add to the start date.
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value, if that's what you want.
' Out:
' Return Value:
' The date of the working day lngDays from the start, taking
' into account weekends and holidays.
' Example:
' dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#,
#2/17/2000#))
' returns #2/25/2000#, which is the date 10 work days
' after 2/9/2000, if you treat 2/16 and 2/17 as holidays
' (just made-up holidays, for example purposes only).
' Did the caller pass in a date? If not, use
' the current date.
Dim lngCount As Long
Dim dtmTemp As Date
If dtmDate = 0 Then
dtmDate = Date
End If
dtmTemp = dtmDate
For lngCount = 1 To lngDays
dtmTemp = dhNextWorkdayA(dtmTemp, adtmDates)
Next lngCount
dhAddWorkDaysA = dtmTemp
End Function
Public Function dhNextWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
' Return the next working day after the specified date.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Requires:
' SkipHolidays
' IsWeekend
' In:
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' The date of the next working day, taking
' into account weekends and holidays.
' Example:
' ' Find the next working date after 5/30/97
' dtmDate = dhNextWorkdayA(#5/23/1997#, #5/26/97#)
' ' dtmDate should be 5/27/97, because 5/26/97 is Memorial day.
' Did the caller pass in a date? If not, use
' the current date.
If dtmDate = 0 Then
dtmDate = Date
End If
dhNextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1)
End Function
Public Function dhPreviousWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
' Return the previous working day before the specified date.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Requires:
' SkipHolidays
' IsWeekend
' In:
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' The date of the previous working day, taking
' into account weekends and holidays.
' Example:
' ' Find the next working date before 1/1/2000
' dtmDate = dhPreviousWorkdayA(#1/1/2000#, Array(#12/31/1999#,
#1/1/2000#))
' ' dtmDate should be 12/30/1999, because of the New Year's
holidays.
' Did the caller pass in a date? If not, use
' the current date.
If dtmDate = 0 Then
dtmDate = Date
End If
dhPreviousWorkdayA = SkipHolidaysA(adtmDates, dtmDate - 1, -1)
End Function
Public Function dhFirstWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
' Return the first working day in the month specified.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Requires:
' SkipHolidays
' IsWeekend
' In:
' dtmDate:
' date within the month of interest.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' The date of the first working day in the month, taking
' into account weekends and holidays.
' Example:
' ' Find the first working day in 1999
' dtmDate = dhFirstWorkdayInMonthA(#1/1/1999#, #1/1/1999#)
Dim dtmTemp As Date
' Did the caller pass in a date? If not, use
' the current date.
If dtmDate = 0 Then
dtmDate = Date
End If
dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
dhFirstWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, 1)
End Function
Public Function dhLastWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
' Return the last working day in the month specified.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Requires:
' SkipHolidays
' IsWeekend
' In:
' dtmDate:
' date within the month of interest.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' The date of the last working day in the month, taking
' into account weekends and holidays.
' Example:
' ' Find the last working day in 1999
' dtmDate = dhLastWorkdayInMonthA(#12/1/1999#, #12/31/1999#)
Dim dtmTemp As Date
' Did the caller pass in a date? If not, use
' the current date.
If dtmDate = 0 Then
dtmDate = Date
End If
dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
dhLastWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, -1)
End Function
Public Function dhCountWorkdaysA(ByVal dtmStart As Date, ByVal dtmEnd
As Date, _
Optional adtmDates As Variant = Empty) _
As Integer
' Count the business days (not counting weekends/holidays) in
' a given date range.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Requires:
' SkipHolidays
' CountHolidays
' IsWeekend
' In:
' dtmStart:
' Date specifying the start of the range (inclusive)
' dtmEnd:
' Date specifying the end of the range (inclusive)
' (dates will be swapped if out of order)
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' Number of working days (not counting weekends and
optionally, holidays)
' in the specified range.
' Example:
' Debug.Print dhCountWorkdaysA(#7/2/2000#, #7/5/2000#, _
' Array(#1/1/2000#, #7/4/2000#))
'
' returns 2, because 7/2/2000 is Sunday, 7/4/2000 is a holiday,
' leaving 7/3 and 7/5 as workdays.
Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer
' Swap the dates if necessary.>
If dtmEnd < dtmStart Then
dtmTemp = dtmStart
dtmStart = dtmEnd
dtmEnd = dtmTemp
End If
' Get the start and end dates to be weekdays.
dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)
dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1)
If dtmStart > dtmEnd Then
' Sorry, no Workdays to be had. Just return 0.
dhCountWorkdaysA = 0
Else
intDays = dtmEnd - dtmStart + 1
' Subtract off weekend days. Do this by figuring out how
' many calendar weeks there are between the dates, and
' multiplying the difference by two (because there are two
' weekend days for each week). That is, if the difference
' is 0, the two days are in the same week. If the
' difference is 1, then we have two weekend days.
intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
' The answer to our quest is all the weekdays, minus any
' holidays found in the table.
intSubtract = intSubtract + _
CountHolidaysA(adtmDates, dtmStart, dtmEnd)
dhCountWorkdaysA = intDays - intSubtract
End If
End Function
Private Function CountHolidaysA( _
adtmDates As Variant, _
dtmStart As Date, dtmEnd As Date) As Long
' Count holidays between two end dates.
'
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Required by:
' dhCountWorkdays
' Requires:
' IsWeekend
Dim lngItem As Long
Dim lngCount As Long
Dim blnFound As Long
Dim dtmTemp As Date
On Error GoTo HandleErr
lngCount = 0
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
' You got an array of variants, or of dates.
' Loop through, looking for non-weekend values
' between the two endpoints.
For lngItem = LBound(adtmDates) To UBound(adtmDates)
dtmTemp = adtmDates(lngItem)
If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
If Not IsWeekend(dtmTemp) Then
lngCount = lngCount + 1
End If
End If
Next lngItem
Case vbDate
' You got one date. So see if it's a non-weekend
' date between the two endpoints.
If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
If Not IsWeekend(adtmDates) Then
lngCount = 1
End If
End If
End Select
ExitHere:
CountHolidaysA = lngCount
Exit Function
HandleErr:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that the code
' include a holiday as a real day, even if
' it's in the table.
Resume ExitHere
End Function
Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
Dim lngItem As Long
On Error GoTo HandleErrors
For lngItem = LBound(avarItemsToSearch) To
UBound(avarItemsToSearch)
If avarItemsToSearch(lngItem) = varItemToFind Then
FindItemInArray = True
GoTo ExitHere
End If
Next lngItem
ExitHere:
Exit Function
HandleErrors:
' Do nothing at all.
' Return False.
Resume ExitHere
End Function
Private Function IsWeekend(dtmTemp As Variant) As Boolean
' If your weekends aren't Saturday (day 7) and Sunday (day 1),
' change this routine to return True for whatever days
' you DO treat as weekend days.
' Modified from code in "Visual Basic Language Developer's
Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Required by:
' SkipHolidays
' dhFirstWorkdayInMonth
' dbLastWorkdayInMonth
' dhNextWorkday
' dhPreviousWorkday
' dhCountWorkdays
If VarType(dtmTemp) = vbDate Then
Select Case Weekday(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End If
End Function
Private Function SkipHolidaysA( _
adtmDates As Variant, _
dtmTemp As Date, intIncrement As Integer) As Date
' Skip weekend days, and holidays in the array referred to by
adtmDates.
' Return dtmTemp + as many days as it takes to get to a day that's
not
' a holiday or weekend.
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
' Required by:
' dhFirstWorkdayInMonthA
' dbLastWorkdayInMonthA
' dhNextWorkdayA
' dhPreviousWorkdayA
' dhCountWorkdaysA
' Requires:
' IsWeekend
Dim strCriteria As String
Dim strFieldName As String
Dim lngItem As Long
Dim blnFound As Boolean
On Error GoTo HandleErrors
' Move up to the first Monday/last Friday, if the first/last
' of the month was a weekend date. Then skip holidays.
' Repeat this entire process until you get to a weekday.
' Unless adtmDates an item for every day in the year (!)
' this should finally converge on a weekday.
Do
Do While IsWeekend(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
Do
blnFound = FindItemInArray(dtmTemp, adtmDates)
If blnFound Then
dtmTemp = dtmTemp + intIncrement
End If
Loop Until Not blnFound
Case vbDate
If dtmTemp = adtmDates Then
dtmTemp = dtmTemp + intIncrement
End If
End Select
Loop Until Not IsWeekend(dtmTemp)
ExitHere:
SkipHolidaysA = dtmTemp
Exit Function
HandleErrors:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that we
' include a holiday as a real day, even if
' it's in the array.
Resume ExitHere
End Function
It jumps from function to function to find the correct info.
