I need to create a report that displays net working days, excluding holidays. This needs to be a calculation or a calculated field. I have custom code to get the weekends accounted for, and have a Holiday dataset that has all the holidays I need to look for in it.
I have set up a hidden parameter on the report for my Holiday dates. The code below runs, but I get a #Error. As you can see have tried extracting and comparing the Year, Month and Day separately, as I thought it was maybe a date/time issue. That still produced #Error.
Function NumWorkDays(ByRef startDate As Date, ByRef endDate As Date) as Integer
dim i as integer
dim x as integer
dim totalDays as Integer
dim WeekendDays as Integer
dim HolidayDays as integer
dim sDate as Date
dim numWeekdays as Integer
numWeekdays = 0
WeekendDays = 0
HolidayDays = 0
sDate=startDate
totalDays = DateDiff(DateInterval.Day, startDate , endDate ) + 1
for i = 1 to totalDays
if DatePart(dateinterval.weekday,sDate ) = 1 then
WeekendDays = WeekendDays + 1
end if
if DatePart(dateinterval.weekday, sDate ) = 7 then
WeekendDays = WeekendDays + 1
end if
sDate = DateAdd("d", 1, sDate )
next i
sDate=startDate
for x = 1 to totalDays
if DatePart(dateinterval.weekday,sDate ) <> 1 or
DatePart(dateinterval.weekday,sDate ) <> 7 then
for i = 1 to Report.Parameters!HolidayParam.Count()
if Year(Report.Parameters!HolidayParam.Value(i))=Year(sDate) and
Month(Report.Parameters!HolidayParam.Value(i))=Month(sDate) and
Day(Report.Parameters!HolidayParam.Value(i))= Day(sDate) then
HolidayDays = HolidayDays + 1
Exit For
End if
next i
end if
sDate = DateAdd("d", 1, sDate )
next x
numWeekdays = totalDays - WeekendDays -HolidayDays
return numWeekdays
End Function
Just looking for ideas as to where I have gone wrong! Thank you!
Okay, I got this. Being new to SSRS I had a difficult time not being able to step through the custom code or put in breakpoints to display values as they occurred! It was simple, it needed to be a multi-valued parameter. I did not check that as I was keeping it hidden, it didn't strike me that it needed that.
I discovered the problem by putting a text box in a Report Header and simply displaying the count of my parameter. When it showed "1", I knew I had the problem!
The updated code snippet is (all the rest remained the same):
for i = 0 to Report.Parameters!HolidayParam.Count()-1
if Report.Parameters!HolidayParam.Value(i))=sDate then
HolidayDays = HolidayDays + 1
Exit For
End if
next i
Related
In Access, I would like to convert a date column in format yywwd to dd-mm-yy. (weekday nr. 1 is monday, and years can only from 2000 and later, so e.g. today (monday 15-06-2020) would be 20251 what I would like to be converted to 15-06-2020.
I'm not much of a coder so honestly asside from messing with Datepart I have not tried a whole lot. Does anyone have suggestion?
It seems that the function 'GetDayFromWeekNumber' mentioned here vba convert week number (and year) to date? could work but how is this used in MSAccess?
Thanks a lot in advance!
I have a function that works in Excel to convert YYWWD to a date, this should be very similar if not identical to the code needed in Access. It is quite verbose so you could probably make it simpler, but at least the calculation steps are clearly set out.
The function assumes the ISO definition of week number - i.e. the first week of the year is the week in which the 4th of Jan falls. The first day of a week is Monday, the last day of a week is Sunday.
Function dateFromYYWWD(yywwd)
Dim sYYWWD As String
Dim sYYYY As String
Dim ww As Integer
Dim d As Integer
Dim fourthOfJan As Date
Dim fourthOfJanWeekday As Integer
Dim week1StartDate As Date
Dim targetWeekStartDate As Date
Dim targetDate As Date
' Convert to string if not already
sYYWWD = "" & yywwd
' Get the year in full
sYYYY = "20" + Left(sYYWWD, 2)
' Get the week number and day in the week
ww = CInt(Mid(sYYWWD, 3, 2))
d = CInt(Right(sYYWWD, 1))
' Calculate the date of 4th Jan in the same year
fourthOfJan = CDate(sYYYY & "-01-04")
' Get the day of week of the 4th Jan
' NOTE - CALCULATES MONDAY AS DAY 1 OF THE WEEK, SUNDAY AS DAY 7
fourthOfJanWeekday = Weekday(fourthOfJan, vbMonday)
' Date of the first day of week #1 in the target year
week1StartDate = fourthOfJan - fourthOfJanWeekday + 1
' First day of the target week
targetWeekStartDate = week1StartDate + (ww - 1) * 7
' Target date
targetDate = targetWeekStartDate + d - 1
dateFromYYWWD = targetDate
End Function
It's as simple as this:
Public Function ConvertFromYYWWD(s) As Date
Dim t&
t = DateSerial(2000 + Mid(s, 1, 2), 1, 1) + 7 * (Mid(s, 3, 2) - 1)
ConvertFromYYWWD = t - Weekday(t, vbMonday) + Mid(s, 5, 1)
End Function
Just place the above function in a code module in the database project.
You mentioned in the comments under your question that the week number is always two digits. I am assuming the the year number is likewise always two digits.
The first task is to split the value:
YWDDate = 20251
Year = YWDDate \ 1000 + 2000
2020
Week = (YWDDate Mod 1000) \ 10
25
Weekday = YWDDate Mod 10
1
Then, as this probably is ISO 8601 week numbering, the year is not the calendar year but the ISO 8601 year, which native VBA knows nothing about, thus a custom function is needed:
' First day of the week.
WeekStart = DateYearWeek(25, 2020, vbMonday)
' Requested day of week (which here is the same)
WeekDate = DateAdd("d", 1 - 1, WeekStart)
The function is not that convoluted:
' Returns the date of Monday for the ISO 8601 week of IsoYear and Week.
' Optionally, returns the date of any other weekday of that week.
'
' 2017-05-03. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateYearWeek( _
ByVal IsoWeek As Integer, _
Optional ByVal IsoYear As Integer, _
Optional ByVal DayOfWeek As VbDayOfWeek = VbDayOfWeek.vbMonday) _
As Date
Dim WeekDate As Date
Dim ResultDate As Date
If IsoYear = 0 Then
IsoYear = Year(Date)
End If
' Validate parameters.
If Not IsWeekday(DayOfWeek) Then
' Don't accept invalid values for DayOfWeek.
Err.Raise DtError.dtInvalidProcedureCallOrArgument
Exit Function
End If
If Not IsWeek(IsoWeek, IsoYear) Then
' A valid week number must be passed.
Err.Raise DtError.dtInvalidProcedureCallOrArgument
Exit Function
End If
WeekDate = DateAdd(IntervalSetting(dtWeek), IsoWeek - 1, DateFirstWeekYear(IsoYear))
ResultDate = DateThisWeekPrimo(WeekDate, DayOfWeek)
DateYearWeek = ResultDate
End Function
but - as you can see - it calls some helper functions, which again call other functions, which will be too much to post here.
I can upload it somewhere, if you feel this will provide a solution for you.
Using MS Access 2010, I need to generate a complete list of dates from an arbitrary start date, say #1/1/2015#, to now, Date(). I would like this list to live in its own table, although a query would work, too. I also would prefer to only grab business days/week days. Can anyone help?
I'm tracking business process errors by date. A new error record is made for each error, and each record is tagged with a date. However, there is not an error on every date. So reporting over time does not give a correct visualization, as the dates without errors are not represented.
I appreciate help generating this list in Access, as well as any alternative ideas for representing this information.
Cheers,
Burgess
Update - I've been able to make a list of dates since a start date. Here's my code:
Sub createDatesTable()
'Declare variables'
Dim startDate As Date
Dim endDate As Date
Dim countDate As Date
Dim length As Long
Dim i As Long
Dim dates() As Date
'Initialize'
startDate = #6/23/2015#
endDate = #9/1/2015#
countDate = startDate
length = endDate - startDate
'Define date array length'
ReDim dates(1 To length)
'Generate date list in array'
For i = 1 To (length)
dates(i) = countDate
countDate = countDate + 1
Next i
'Print array to Immediate Window'
For i = 1 To length
Debug.Print dates(i)
Next i
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblDateList", dbOpenDynaset)
'Add array data to existing table'
For i = 1 To length
rs.AddNew
rs!DateList = dates(i)
rs.Update
Next i
rs.Close
db.Close
End Sub
Now, I'm very new to VBA, so this may well contain elementary mistakes. Thanks for the feedback.
-Burgess
Your table can have a structure like this:
Column name | Data type
---------------+----------
dt | DateTime
isBusinessDay | Yes/No
And as for the filling, something like this:
public sub fillDates(startDate as date, endDate as date)
dim db as DAO.database, rs as DAO.Recordset
dim strSQL as string
dim d as date
strSQL = "delete from tbl_dates"
docmd.runsql strSQL
set db = currentdb()
set rs = db.openRecordset("tbl_dates", dbOpenDynaset, dbAppendOnly)
for d = startDate to endDate
with rs
.addNew
![dt] = d
![isBusinessDay] = (format(d, "w", vbMonday) <= 5)
.update
end with
next d
rs.close
db.close
end sub
I have a Microsoft Access database where the user is required to enter a Date Opened: value. Once entered, this triggers a calculation in another field, Deadline (25 WD):. This works via the following function in the latter field:
=DateAdd("d",25,[Date opened])
What I want to do, however, is to count 25 working days from the date entered in Date Opened:. I have a table holidays which contains a list of UK holidays up until 2020.
How can I merge to two, so-to-speak, in order to produce a valid Deadline (25 WD): value which does not count any of the dates listed in holidays?
For example, if the date entered is 01/01/2015, then the function would count 25 working days from 01/01/2015, meaning that it would exclude all weekends and any bank holidays that fall within that period and the resulting date value in the field Deadline (25 WD) will also be a working day (i.e. not a weekend or bank holiday).
You might need a UDF to get you through this. Something like,
Function addWorkDays(addNumber As Long, Date2 As Date) As Date
'********************
'Code Courtesy of
' Paul Eugin
'********************
Dim finalDate As Date
Dim i As Long, tmpDate As Date
tmpDate = Date2
i = 1
Do While i <= addNumber
If Weekday(tmpDate) <> 1 And Weekday(tmpDate) <> 7 And _
DCount("*", "tbl_BankHolidays", "bankDate = " & Format(tmpDate, "\#mm\/dd\/yyyy\#")) = 0 Then i = i + 1
tmpDate = DateAdd("d", 1, tmpDate)
Loop
Do While Weekday(tmpDate) = 1 Or Weekday(tmpDate) = 7 Or _
DCount("*", "tbl_BankHolidays", "bankDate = " & Format(tmpDate, "\#mm\/dd\/yyyy\#")) <> 0
tmpDate = DateAdd("d", 1, tmpDate)
Loop
addWorkDays = tmpDate
End Function
So, when you add 25 days to a date, it will skip all weekends and bank holidays stored in your table - tbl_BankHolidays.
? addWorkDays(25, Date())
25/06/2015
Hope this helps !
EDIT: I have added another loop to see if the end date falls on a bank holiday or weekend, if it does it will add one more day until it reaches a weekday.
You can use this function:
Public Function DateAddWorkdays( _
ByVal lngNumber As Long, _
ByVal datDate As Date, _
Optional ByVal booWorkOnHolidays As Boolean) _
As Date
' Adds lngNumber of workdays to datDate.
' 2014-10-03. Cactus Data ApS, CPH
' Calendar days per week.
Const clngWeekdayCount As Long = 7
' Workdays per week.
Const clngWeekWorkdays As Long = 5
' Average count of holidays per week maximum.
Const clngWeekHolidays As Long = 1
' Maximum valid date value.
Const cdatDateRangeMax As Date = #12/31/9999#
' Minimum valid date value.
Const cdatDateRangeMin As Date = #1/1/100#
Dim aHolidays() As Date
Dim lngDays As Long
Dim lngDiff As Long
Dim lngDiffMax As Long
Dim lngSign As Long
Dim datDate1 As Date
Dim datDate2 As Date
Dim datLimit As Date
Dim lngHoliday As Long
lngSign = Sgn(lngNumber)
datDate2 = datDate
If lngSign <> 0 Then
If booWorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between datDate and datDate + lngDiffMax.
' Calculate the maximum calendar days per workweek.
lngDiffMax = lngNumber * clngWeekdayCount / (clngWeekWorkdays - clngWeekHolidays)
' Add one week to cover cases where a week contains multiple holidays.
lngDiffMax = lngDiffMax + Sgn(lngDiffMax) * clngWeekdayCount
datDate1 = DateAdd("d", lngDiffMax, datDate)
aHolidays = GetHolidays(datDate, datDate1)
End If
Do Until lngDays = lngNumber
If lngSign = 1 Then
datLimit = cdatDateRangeMax
Else
datLimit = cdatDateRangeMin
End If
If DateDiff("d", DateAdd("d", lngDiff, datDate), datLimit) = 0 Then
' Limit of date range has been reached.
Exit Do
End If
lngDiff = lngDiff + lngSign
datDate2 = DateAdd("d", lngDiff, datDate)
Select Case Weekday(datDate2)
Case vbSaturday, vbSunday
' Skip weekend.
Case Else
' Check for holidays to skip.
' Ignore error when using LBound and UBound on an unassigned array.
On Error Resume Next
For lngHoliday = LBound(aHolidays) To UBound(aHolidays)
If Err.Number > 0 Then
' No holidays between datDate and datDate1.
ElseIf DateDiff("d", datDate2, aHolidays(lngHoliday)) = 0 Then
' This datDate2 hits a holiday.
' Subtract one day before adding one after the loop.
lngDays = lngDays - lngSign
Exit For
End If
Next
On Error GoTo 0
lngDays = lngDays + lngSign
End Select
Loop
End If
DateAddWorkdays = datDate2
End Function
Public Function GetHolidays( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booDesc As Boolean) _
As Date()
' Finds the count of holidays between datDate1 and datDate2.
' The holidays are returned as an array of dates.
' DAO objects are declared static to speed up repeated calls with identical date parameters.
' 2014-10-03. Cactus Data ApS, CPH
' The table that holds the holidays.
Const cstrTable As String = "tblHoliday"
' The field of the table that holds the dates of the holidays.
Const cstrField As String = "HolidayDate"
' Constants for the arrays.
Const clngDimRecordCount As Long = 2
Const clngDimFieldOne As Long = 0
Static dbs As DAO.Database
Static rst As DAO.Recordset
Static datDate1Last As Date
Static datDate2Last As Date
Dim adatDays() As Date
Dim avarDays As Variant
Dim strSQL As String
Dim strDate1 As String
Dim strDate2 As String
Dim strOrder As String
Dim lngDays As Long
If DateDiff("d", datDate1, datDate1Last) <> 0 Or DateDiff("d", datDate2, datDate2Last) <> 0 Then
' datDate1 or datDate2 has changed since the last call.
strDate1 = Format(datDate1, "\#yyyy\/mm\/dd\#")
strDate2 = Format(datDate2, "\#yyyy\/mm\/dd\#")
strOrder = Format(booDesc, "\A\s\c;\D\e\s\c")
strSQL = "Select " & cstrField & " From " & cstrTable & " " & _
"Where " & cstrField & " Between " & strDate1 & " And " & strDate2 & " " & _
"Order By 1 " & strOrder
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
' Save the current set of date parameters.
datDate1Last = datDate1
datDate2Last = datDate2
End If
lngDays = rst.RecordCount
If lngDays = 0 Then
' Leave adatDays() as an unassigned array.
Else
ReDim adatDays(lngDays - 1)
' As repeated calls may happen, do a movefirst.
rst.MoveFirst
avarDays = rst.GetRows(lngDays)
' rst is now positioned at the last record.
For lngDays = LBound(avarDays, clngDimRecordCount) To UBound(avarDays, clngDimRecordCount)
adatDays(lngDays) = avarDays(clngDimFieldOne, lngDays)
Next
End If
' DAO objects are static.
' Set rst = Nothing
' Set dbs = Nothing
GetHolidays = adatDays()
End Function
so I'm trying to get 2 dates in an excel sheet and use the DateDiff function to get the number of days between the 2 dates. I am essentially adding the number of days together and dividing by the the number of rows to get and average amount of days. So far I have it to where the total amount of days for every row gets added together and is displayed on column "E" and the number of rows is placed on column "F". I know I am close because at one point it worked but I was dumb and changed something and now i does not. here is my code and the excel sheet.
Sub GetDays()
Range("C1").Select
Do Until ActiveCell.Value = ""
date1 = DateValue(ActiveCell.Offset(1, 0).Value)
date2 = DateValue(ActiveCell.Offset(1, 0).EntireRow.Cells(1, "D").Value)
DayCount = DateDiff("d", date1, date2) + DayCount
ActiveCell.Offset(1, 0).EntireRow.Cells(1, "E").Value = DayCount
StudentCount = StudentCount + 1
ActiveCell.Offset(1, 0).EntireRow.Cells(1, "F").Value = StudentCount
ActiveCell.Offset(1, 0).Select
Loop
End Sub!
Here is a snippet of the sheet
The issue I discovered when testing your code is that your loop is comparing to the ActiveCell value to determine when to exit, but then your code is operating on the cell below ActiveCell, as a result of the Offset(1,0) call. So when your loop is on the last line of data, ActiveCell.Value = "3/25/2015 10:52", but your next line of code is trying to populate date1 with the DateValue of a null since it is offset down one row. This throws a Type Mismatch error.
I've adjusted your code below, this works for me:
Sub GetDays()
Range("C1").Select
Do Until ActiveCell.Value = ""
date1 = DateValue(ActiveCell.Value)
date2 = DateValue(ActiveCell.Offset(0, 1).Value)
DayCount = DateDiff("d", date1, date2) + DayCount
ActiveCell.Offset(0, 2).Value = DayCount
StudentCount = StudentCount + 1
ActiveCell.Offset(0, 3).Value = StudentCount
ActiveCell.Offset(1, 0).Select
Loop
End Sub
I adjusted the offset command so that we are looking at the same row at all times each loop. I replaced the "EntireRow.Cells(1, "D")" sections by just using the column integer in Offset().
You may need to change the second line to: Range ("C2").Select for my code to work, depending on if your data starts on row 1 or row 2.
I have a Calendar program, that reside on the server, this program stores the dates into the database in the format :
YYYYMMDD
is there a "easy" way to manage these dates in asp? for example, let's assume we have the April 20th 2013 as a date:
20130420
we want to add 20 days to this date, so we want to produce:
20130510
any idea? is there a integerTOdate conversion in asp? or something i could use to add "days" to the number 20130420 ?
Something like this (untested):
Dim strDate, theDate, theDatePlusTwentyDays
Dim Year, Month, Day
' The date is stored as a string...
strDate = "20130420"
' Extract the components of the date
Year = Mid(strDate, 1, 4)
Month = Mid(strDate, 5, 2)
Day = Mid(strDate, 7, 2)
' Convert the components of the date into a datetime object
theDate = DateSerial(Year, Month, Day)
' Add 20 days using DateAdd
theDatePlusTwentyDays = DateAdd("d", 20, theDate)
Yes, you can use the DateAdd function
Response.Write(DateAdd("d",1,Now()))
You need to format your date first though into something like
<%
dim _dateOnServer
dim _formattedDate
dim _day
dim _month
dim _year
_dateOnServer = 20130420
_year = Left(_dateOnServer,4)
_month = Mid(_dateOnServer,5,2)
_day = Right(_dateOnServer,2)
_formattedDate = _month &"-"& _day &"-"& _year
dim _newDate
_newDate = DateAdd("d",20, _formattedDate )
_day = Left(_newDate,2)
_month = Mid(_newDate,4,2)
_year = Right(_newDate,4)
dim _newDateFormat
_newDateFormat = _year & _month & _day
%>
A solution that enables full control over order and format...
strDay = Day(Date)
strMonth = Month(Date)
strYear = Year(Date)
strHours = Hour(Now)
strMins = Minute(Now)
strSecs = Second(Now())
if len(strMonth) = 1 then
strMonth = "0" & strMonth
end if
if len(strDay) = 1 then
strDay = "0" & strDay
end if
if len(strHours) = 1 then
strHours = "0" & strHours
end if
if len(strMins) = 1 then
strMins = "0" & strMins
end if
if len(strSecs) = 1 then
strSecs = "0" & strSecs
end if
strDateAdded = strYear & "-" & strMonth & "-" & strDay
strDateAddedTime = strDateAdded & " " & strHours & ":" & strMins
Using this method you have complete control over the order and even when running your web app in different time zones, you still maintain DD/MM format... or whatever order you want such as MM-DD-YY (by reordering and trimming the year). Personally I prefer YYYY-MM-DD because sorting by ASC and DESC is a lot easier to work with, ie: easier to read because all rows will have the same number of characters like:
2013-04-01 03:15
2013-04-09 10:15
2013-04-22 07:15
2013-04-23 10:15
2013-04-23 10:60
2013-10-25 12:01
2013-10-25 12:59
Instead of:
2013-4-1 3:15
2013-4-9 10:15
2013-4-22 7:15
2013-4-23 10:15
2013-4-23 10:60
2013-10-25 12:1
2013-1-25 12:59