Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
TODAY'S DATE PLUS "BUSINESS" DAYS
How do I calculate todays date plus say, 90 "business" days?
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
TODAY'S DATE PLUS "BUSINESS" DAYS
take a look at WORKDAY function in help. It is part of the Analysis Toolpak.
-- HTH RP (remove nothere from the email address if mailing direct) "Lisa" wrote in message ... How do I calculate todays date plus say, 90 "business" days? |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
TODAY'S DATE PLUS "BUSINESS" DAYS
Business days is tricky... Here is a module that I use for business days. You
need a database of Holdays to go with this... Option Explicit Private Const m_cHolidaysDataBasePath As String = "D:/" Private Const m_cHolidaysDataBaseName As String = "Holidays.MDB" Public Const g_cUSHolidays As String = "tblUS" Public Const g_cCdnHolidays As String = "tblCanada" Public Function WorkDays(ByVal dteStartDate As Date, ByVal dteEndDate As Date, _ ByVal strTableName As String) As Integer Dim rst As DAO.Recordset Dim db As DAO.Database Set db = DAO.DBEngine.OpenDatabase(m_cHolidaysDataBasePath & m_cHolidaysDataBaseName) Set rst = db.OpenRecordset(strTableName, DAO.dbOpenDynaset) WorkDays = dhCountWorkdays(dteStartDate, dteEndDate, rst, "Date") End Function Private Sub TestSkipHolidays() Dim rst As DAO.Recordset Dim db As DAO.Database Set db = DAO.DBEngine.OpenDatabase(m_cHolidaysDataBasePath & m_cHolidaysDataBaseName) Set rst = db.OpenRecordset("tblHolidays", _ DAO.dbOpenDynaset) Debug.Print dhFirstWorkdayInMonth(#12/25/2003#, rst, "Date") Debug.Print dhLastWorkdayInMonth(#12/25/2003#, rst, "Date") Debug.Print dhNextWorkday(#12/25/2003#, rst, "Date") Debug.Print dhNextWorkday(#12/25/2003#, rst, "Date") Debug.Print dhPreviousWorkday(#12/25/2003#, rst, "Date") Debug.Print dhPreviousWorkday(#12/25/2003#, rst, "Date") End Sub Private Sub TestCountWorkdays() Dim rst As DAO.Recordset Dim db As DAO.Database Set db = DAO.DBEngine.OpenDatabase(m_cHolidaysDataBasePath & m_cHolidaysDataBaseName) Set rst = db.OpenRecordset("tblHolidays", _ DAO.dbOpenDynaset) Debug.Print dhCountWorkdays(#12/1/2003#, #12/31/2003#, _ rst, "Date") Debug.Print dhCountWorkdays(#12/1/2003#, #12/31/2003#) End Sub Private Function SkipHolidays(rst As Recordset, _ strField As String, dtmTemp As Date, intIncrement As Integer) _ As Date ' Skip weekend days, and holidays in the ' recordset referred to by rst. Dim strCriteria As String On Error GoTo HandleErr ' 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 rst contains a row for every day in the year (!) ' this should finally converge on a weekday. Do Do While IsWeekend(dtmTemp) dtmTemp = dtmTemp + intIncrement Loop If Not rst Is Nothing Then If Len(strField) 0 Then If Left(strField, 1) < "[" Then strField = "[" & strField & "]" End If Do strCriteria = strField & _ " = #" & Format(dtmTemp, "mm/dd/yy") & "#" rst.FindFirst strCriteria If Not rst.NoMatch Then dtmTemp = dtmTemp + intIncrement End If Loop Until rst.NoMatch End If End If Loop Until Not IsWeekend(dtmTemp) ExitHe SkipHolidays = dtmTemp Exit Function HandleErr: ' No matter what the error, just ' return without complaining. ' The worst that could happen is that the code ' includes a holiday as a real day, even if ' it's in the table. Resume ExitHere End Function 'Function dhFirstWorkdayInMonth(Optional dtmDate As Date = 0, _ ' Optional rst As Recordset = Nothing, _ ' Optional strField As String = "") As Date ' ' Return the first working day in the month specified. ' Dim dtmTemp As Date ' Dim strCriteria As String ' If dtmDate = 0 Then ' ' Did the caller pass in a date? If not, use ' ' the current date. ' dtmDate = Date ' End If ' dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1) ' dhFirstWorkdayInMonth = SkipHolidays(rst, strField, _ ' dtmTemp, 1) 'End Function Public Function dhLastWorkdayInMonth(Optional dtmDate As Date = 0, _ Optional rst As Recordset = Nothing, _ Optional strField As String = "") As Date ' Return the last working day in the month specified. Dim dtmTemp As Date Dim strCriteria As String If dtmDate = 0 Then ' Did the caller pass in a date? If not, use ' the current date. dtmDate = Date End If dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0) dhLastWorkdayInMonth = SkipHolidays(rst, strField, _ dtmTemp, -1) End Function Public Function dhFirstWorkdayInMonth(Optional dtmDate As Date = 0, _ Optional rst As Recordset = Nothing, _ Optional strField As String = "") As Date ' Return the first working day in the month specified. Dim dtmTemp As Date Dim strCriteria As String If dtmDate = 0 Then ' Did the caller pass in a date? If not, use ' the current date. dtmDate = Date End If dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1) dhFirstWorkdayInMonth = SkipHolidays(rst, strField, _ dtmTemp, 1) End Function Private Function dhCountWorkdays(ByVal dtmStart As Date, _ ByVal dtmEnd As Date, _ Optional rst As Recordset = Nothing, _ Optional strField As String = "") _ As Integer 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 = SkipHolidays(rst, strField, dtmStart, 1) dtmEnd = SkipHolidays(rst, strField, dtmEnd, -1) If dtmStart dtmEnd Then ' Sorry, no workdays to be had. Just return 0. dhCountWorkdays = 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 (since 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 you have two weekend days. intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2) ' The answer, finally, is all the weekdays, minus any ' holidays found in the table. ' If rst is Nothing, this call won't subtract any dates. intSubtract = intSubtract + CountHolidays(dtmStart, dtmEnd, rst, _ strField) ' intSubtract = intSubtract + 0 dhCountWorkdays = intDays - intSubtract End If End Function Private Function CountHolidays(ByVal dtmStart As Date, _ ByVal dtmEnd As Date, _ Optional rst As Recordset = Nothing, _ Optional strField As String = "") _ As Integer Dim intDays As Integer Dim dtmTemp As Date Dim intReturnValue As Integer ' Swap the dates if necessary. If dtmEnd < dtmStart Then dtmTemp = dtmStart dtmStart = dtmEnd dtmEnd = dtmTemp End If If Not rst Is Nothing Then rst.MoveFirst Do While Not rst.EOF If rst.Fields(1) = dtmStart And rst.Fields(1) <= dtmEnd Then intReturnValue = intReturnValue + 1 End If rst.MoveNext Loop End If CountHolidays = intReturnValue End Function Public Function IsWeekend(dtmTemp As Date) 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. Select Case Weekday(dtmTemp) Case vbSaturday, vbSunday IsWeekend = True Case Else IsWeekend = False End Select End Function Public Function dhNextWorkday(Optional dtmDate As Date = 0, _ Optional rst As Recordset = Nothing, _ Optional strField As String = "") As Date ' Return the next working day after the specified date. Dim dtmTemp As Date Dim strCriteria As String If dtmDate = 0 Then ' Did the caller pass in a date? If not, use ' the current date. dtmDate = Date End If dhNextWorkday = SkipHolidays(rst, strField, dtmDate + 1, 1) End Function Public Function dhPreviousWorkday(Optional dtmDate As Date = 0, _ Optional rst As Recordset = Nothing, _ Optional strField As String = "") As Date Dim dtmTemp As Date Dim strCriteria As String If dtmDate = 0 Then ' Did the caller pass in a date? If not, use ' the current date. dtmDate = Date End If dhPreviousWorkday = SkipHolidays(rst, strField, _ dtmDate - 1, -1) End Function "Lisa" wrote: How do I calculate todays date plus say, 90 "business" days? |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
TODAY'S DATE PLUS "BUSINESS" DAYS
Hi
=WORKDAY(TODAY(),90) Note: you nneed to install the Analysis Toolpak Addin for this -- Regards Frank Kabel Frankfurt, Germany "Lisa" schrieb im Newsbeitrag ... How do I calculate todays date plus say, 90 "business" days? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to go "X" number of days out from a undefined date? | Excel Discussion (Misc queries) | |||
get a runing total for"curent date"or(cell)minus prev 30 days( cel | Excel Worksheet Functions | |||
can we convert "2 days 16 hrs" to " 64hrs" using excel functions | Excel Worksheet Functions | |||
"DAYS 360" and the date Feb 28th as start and end | Excel Worksheet Functions | |||
AutoFilter, using "Today's Date" | Excel Discussion (Misc queries) |