Try:
Function CountWeekDays(ByVal dtStartDate As Date, ByVal dtEndDate As Date, _
Optional ByVal lFirstDayOfWeek As VbDayOfWeek = vbMonday) As Long
Dim lWeekDays As Long
Dim dtCurrentDate As Date
Dim iNeg As Integer
If dtEndDate < dtStartDate Then
iNeg = -1
dtCurrentDate = dtStartDate
dtStartDate = dtEndDate
dtEndDate = dtCurrentDate
End If
End Function [/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
And if you want to include holidays, create a function to get the number of holidays with-in the range (CountHolidaysInRange_pFlng) and add this line: If bCalcHolidays Then lWeekDays = lWeekDays + CountHolidaysInRange_pFlng(dtStartDate, dtEndDate, bWeekDaysOnly:=True, lFirstDayOfWeek:=lFirstDayOfWeek)
CountWeekDays_pFlng2 = lWeekDays
End Function [/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
Please explain how this works. In particular, the holidays bit. For example, generate some scenario where the basic function wouuld 'end' with a friday date - but there is a (one) holiday, Doesn't that "push" the result one day (to SAT?) which violatets the "WeekDay" expectation?
And, since this is apparently a NOVICE, what/where is the CountHolidaysInRange_pFlng function?
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
Obviously I like my solution there the best (it's certainly the most obscure), but there are several alternatives presented there plus discussion of why some approaches (e.g. the simple DateDiff solution) don't quite work.
There is an error [Beep] anyways.
I will post a correction later along with the holiday bit: [/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
Ok. Here are the functions. They are divided up to offer more flexibility and work(hopefully) internationally.
They should allow the user to determine which day-of-the-week is the first day - the first day being the first Work day. There could be more flexibilty added (the actual function which I use allows the user to determine exactly which days are work days - some countries a Weds and Sun. may be the weekend days, or a Sat. is always a legal workday). So, hopefully if all works right, the user doesn't have to depend on Moday as being the first work day, and Sunday a day off...
=========================================================
MichaelRed: I only mentioned the possibility of the holiday function, even though the questioner didn't ask for it. The holiday function, as you should have seen above, calculates and returns the number of holidays that fall with-in the time period, based on whether the user wants included in the count the holidays which fall on a weekend or not:
bWeekDaysOnly:=True
=========================================================
The day of the year today is 298, not 297
=========================================================
Public Function CountWeekDays_pFlng(ByRef dtStartDate As Date, ByRef dtEndDate As Date, _
Optional ByVal bCalcHolidays As Boolean = True, _
Optional ByVal lFirstDayOfWeek As VbDayOfWeek = vbMonday) As Long
Dim lWeeks As Long
Dim lWeekDays As Long
Dim dtCurrentDate As Date
Dim iSgn As Integer
iSgn = Sgn(dtEndDate - dtStartDate)
If iSgn = 0 Then
Exit Function 'Dates are equal
ElseIf iSgn = -1 Then
'Flip the dates
dtCurrentDate = dtStartDate
dtStartDate = dtEndDate
dtEndDate = dtCurrentDate
End If
dtCurrentDate = dtStartDate + (lWeeks * 7)
If Weekday(dtCurrentDate, lFirstDayOfWeek) < vbSaturday Then dtCurrentDate = dtCurrentDate + 1
Do Until dtCurrentDate > dtEndDate
lWeekDays = lWeekDays + Abs(Weekday(dtCurrentDate, lFirstDayOfWeek) < 6)
dtCurrentDate = dtCurrentDate + 1
Loop
If bCalcHolidays Then lWeekDays = lWeekDays - CountHolidaysInRange_pFlng(dtStartDate, dtEndDate, bWeekDaysOnly:=True, lFirstDayOfWeek:=lFirstDayOfWeek)
CountWeekDays_pFlng = lWeekDays * iSgn
End Function ============================================================
Private Function CountHolidaysInRange_pFlng(Optional ByVal sStartDate As String, Optional ByVal sEndDate As String, _
Optional ByVal bWeekDaysOnly As Boolean = True, _
Optional ByVal lFirstDayOfWeek As VbDayOfWeek = vbMonday) As Long
Dim sList As Variant
Dim dtItem As Variant
Dim sCurrentDate As String
Dim lHolidays As Long
If sEndDate < sStartDate Then
'Flip the dates
sCurrentDate = sStartDate
sStartDate = sEndDate
sEndDate = sCurrentDate
End If
'Get liat of Holidays between the date range
sList = GetHolidaysInRange_pFlng(sStartDate, sEndDate)
If Not IsEmpty(sList) Then
If bWeekDaysOnly Then
'Check if the date is a weekday or not
For Each dtItem In sList
If Weekday(dtItem, lFirstDayOfWeek) < vbSaturday Then lHolidays = lHolidays + 1
Next dtItem
Else
lHolidays = UBound(sList) - LBound(sList)
End If
End If
CountHolidaysInRange_pFlng = lHolidays
End Function ============================================================
'The Holiday Data: Could be just any array of dates returned
Private Function GetHolidaysInRange_pFlng(Optional ByVal sStartDate As String, Optional ByVal sEndDate As String) As Variant
sqlString = "SELECT datum FROM Holidays"
If IsDate(sStartDate) And IsDate(sEndDate) Then sqlString = sqlString _
& " WHERE datum BETWEEN " & Format$(sStartDate, gcSQLDATE) & " AND " & Format$(sEndDate, gcSQLDATE)
With rsData
.CursorLocation = adUseServer
.Open sqlString, conPubs, adOpenKeyset
If Not .EOF Then
'Use the GetString to retrieve data comma delimited
sGetString = rsData.GetString(RowDelimeter:=gcCOMMA)
'Remove last comma
If Right$(sGetString, 1) = gcCOMMA Then sGetString = Left$(sGetString, Len(sGetString) - 1)
'Use Split function to change string to an array
GetHolidaysInRange_pFlng = Split(sGetString, gcCOMMA)
End If
.Close
End With
conPubs.Close
ExitProceedure:
Set conPubs = Nothing
Set rsData = Nothing
Exit Function
ErrHandler:
'Place your error handler here
End Function [/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
In my copying and pasting, there is a couple of extra things and things missing:
1. Remove the following in the CountHolidaysInRange_pFlng function:
Dim sCurrentDate As String
sCurrentDate = sStartDate
2. In the function GetHolidaysInRange_pFlng the Start and EndDates are optional so a Check needs to be done and the WHERE clause build accordingly.
You could also make the EndDate optional, and the start date not optional.
In which case the end date would default to todays date (Date)
[/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
Shoot, forget that. I was looking at two different pieces of code.
[/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
MichaelRed: I meant to forget what I had written in the post just prior to:
The words: "forget that", means to "ignor that which I had just stated", in this case:
>In my copying and pasting, there is a couple of extra things and things missing:
I thought that this was clear enough. Sorry if it wasn't.
[/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
I still get a discrepancy between you collective and the other approaches. I believe it is related to your development of the number of days (lweekdays). This is done by multiplying the number of weeks in hte given interval by 5, however -like all of the MS date functions, this only counts the BOUNDARIES between the dates. Thus for example, using 1/1/02 and DATE (~ 10/27/02) the lweeks returns 42. 42 * 5 = 210, but this ignores the days which are in the first week of the year - but NOT in the boundary crossing?
In your continuing effort to re-invent this particular wheel, perhaps some small amount of extra rounding has been introduced?
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
Returns -1 [/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
This small detail was left out for the parameters of DateDiff function- the 1st day of week and year.
===================================================
In using this function returning the whole weeks was the only number of interest at this point.
The count of whole weeks, using 01/01/2002 as a start, should return 210. This calculates the number of weeks between that date and the last tuesday prior to the end date (because Tuesday, the 22nd Oct, was the start day).
Then in the next section the days are checked between the last tuesday prior to the end date (22 Oct.) and the actual end date (27 Oct).
The problem is the start date (dtCurrentDate) used for the loop:
Do Until dtCurrentDate > dtEndDate
So, we need to change: If Weekday(dtCurrentDate, lFirstDayOfWeek) < vbSaturday Then dtCurrentDate = dtCurrentDate + 1
To this:
If lWeeks = 0 Then dtCurrentDate = dtCurrentDate + 1
==============================================
>re-invent this particular wheel
No, I do not think so. Show me another function where it is working properly.
[/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
strongm (MIS) Oct 25, 2002
Here's the thread: Thread222-361893
Where strongm posted a routine, you posted some information and at least a part of the process and I referenced the FAQ which I posted quite a while back.
Of course, with these latest changes, I believe Your routine returns the same value as the others.
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
I tried the DeltaDays function but it also does not work properly under all circumstances.
On my system (excluding the holiday function):
One of these must be wrong.
DeltaDays("10/24/02","10/24/02" = 1 Thurs to Thurs
DeltaDays("10/24/02","10/25/02" = 1 Thurs to Fri
And then while:
DeltaDays("01/01/02","10/27/02" return 214
DeltaDays("10/22/02","10/27/02" retuns 4
One of these must also be wrong. (same problem as my last error, only in reverse)
And:
DeltaDays("10/26/02","10/27/02" returns 1
Must also be wrong (both fall on a weekend) [/b][/i][/u][sub]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.