Solved

How can I calculate the difference, in # of weeks, between two dates that span a new year

Posted on 2012-09-06
500 Views
How can I calculate the difference, in # of weeks, between two dates that span a new year?   I have code below that assigns the the week number to a variable for datefields using the format function then distributes the number of hours entered in another field across each of the weeks between the two dates.  ProjToTest is the begin /first date, ProjWitnessTest is the end / second date.

I need to be able to distribute the hours across the weeks when the dates span a new year.  The year is stored as a seperate field (i.e. 2012) also.

Dim cwProjToTest As Integer
Dim cwProjWitnessTest As Integer

If IsDate(Me.ProjToTest) = True Then cwProjToTest = Format(Me.ProjToTest, "ww", vbMonday, vbFirstFourDays)
If IsDate(Me.ProjWitnessTest) = True Then cwProjWitnessTest = Format(Me.ProjWitnessTest, "ww", vbMonday, vbFirstFourDays)

weeks = cwProjWitnessTest - cwProjToTest + 1
i = 0
If cwProjToTest >= 1 Then
MsgBox "cwProjToTest >1", vbOKOnly
Do Until i = weeks
tblWork!Engineer = Me.Engineer
tblWork.Week = cwProjToTest - i
If IsDate(Me.ProjToTest) Then tblWork.Year = Format(Me.ProjToTest, "yyyy")
tblWork.Hours = Round(Me.TestHours / weeks, 0)
tblWork.Reason = Me.Order
tblWork.Note = "Test"
tblWork.Update
i = i + 1
Loop
End If
0
Question by:conardb

LVL 3

Expert Comment

Use DateDiff

DateDiff(interval,date1,date2[,firstdayofweek[,firstweekofyear]])

http://www.w3schools.com/vbscript/func_datediff.asp
0

LVL 92

Expert Comment

Depends on what you mean by "# of weeks, between two dates that span a new year".

For example, you could use:

``````Debug.Print DateDiff("ww", Date1, Date2)
``````

Note, however, that DateDiff is counting the number of interval boundaries between two dates, and not true elapsed time.

For example, DateDiff("ww", #12/1/2011#, #1/1/2012#) will return 1, because there is a week boundary between those two dates, whereas only one day elapsed.  Note also that DateDiff("ww", #9/2/2012#, #9/8/2012#) will return 0, because a week boundary is not crossed between the two dates.

If you want the true elapsed time, find how many days passed, and then divide by 7:

``````Debug.Print DateDiff("d", Date1, Date2) / 7
``````

Or, to show only full weeks elapsed:

``````Debug.Print DateDiff("d", Date1, Date2) \ 7
``````
0

Author Comment

Thanks, Presently, the existing code is assigning the division of the total hours by each week number for each of the weeks between the two dates and I'm having problems when the two dates span a new year.  So, for date1 = 12/01/2012 and date2 = 12/31/2012 I need to to distribute 40 hours  across weeks 49-52 of year 2012 as below.
year, week, hours
2012, 52, 10
2012, 51, 10
2012, 50, 10
2012, 49, 10

for date1 = 12/01/2012 and date2 = 1/31/2013 I need to to distribute 40 hours  across weeks 49-52 of year 2012  and 1-4 as below.  I am noticing a week zero being returned so the week numbers may be different.

year, week, hours
2013, 4, 5
2013, 3, 5
2013, 2, 5
2013, 1, 5
2012, 52, 5
2012, 51, 5
2012, 50, 5
2012, 49, 5
0

LVL 48

Expert Comment

You will need some additional function to calculate the ISO week numbering correctly because VB(A) is buggy for weeknumber 52/53.
``````' Your function modified (air code, not tested):

Dim datProjToTest       As Date
Dim datProjWitnessTest  As Date
Dim datWeek             As Date
Dim intWeeks            As Integer
Dim bytWeek             As Byte
Dim intYear             As Integer

If IsDate(Me!ProjToTest) = True Then
datProjToTest = Me!ProjToTest
End If
If IsDate(Me!ProjWitnessTest) = True Then
datProjWitnessTest = Me!ProjWitnessTest
End If

' Do something if not having two useful dates.

intWeeks = DateDiff("ww", datProjToTest, datProjWitnessTest)

For bytWeek = 0 To intWeeks - 1
' Retrieve ISO year and week.
Call ISO_WeekYearNumber(datWeek, intYear, bytWeek)
tblWork!Engineer = Me!Engineer
tblWork!Week = bytWeek
tblWork!Year = intYear
tblWork!Hours = Round(Me!TestHours / intWeeks, 0)
tblWork!Reason = Me!Order
tblWork!Note = "Test"
tblWork.Update
Next
tblWork.Close

' Sup. functions:

Public Function ISO_WeekYearNumber( _
ByVal datDate As Date, _
Optional ByRef intYear As Integer, _
Optional ByRef bytWeek As Byte) _
As String

' Calculates and returns year and week number for date datDate according to the ISO 8601:1988 standard.
' Optionally returns numeric year and week.
' 1998-2007, Gustav Brock, Cactus Data ApS, CPH.
' May be freely used and distributed.

Const cbytFirstWeekOfAnyYear  As Byte = 1
Const cbytLastWeekOfLeapYear  As Byte = 53
Const cbytMonthJanuary        As Byte = 1
Const cbytMonthDecember       As Byte = 12
Const cstrSeparatorYearWeek   As String = "W"

Dim bytMonth                  As Byte
Dim bytISOThursday            As Byte
Dim datLastDayOfYear          As Date

intYear = Year(datDate)
bytMonth = Month(datDate)
bytWeek = DatePart("ww", datDate, vbMonday, vbFirstFourDays)

If bytWeek = cbytLastWeekOfLeapYear Then
bytISOThursday = Weekday(vbThursday, vbMonday)
datLastDayOfYear = DateSerial(intYear, cbytMonthDecember, 31)
If Weekday(datLastDayOfYear, vbMonday) >= bytISOThursday Then
' OK, week count of 53 is caused by leap year.
Else
' Correct for Access97/2000+ bug.
bytWeek = cbytFirstWeekOfAnyYear
End If
End If

' Adjust year where week number belongs to next or previous year.
If bytMonth = cbytMonthJanuary Then
If bytWeek >= cbytLastWeekOfLeapYear - 1 Then
' This is an early date of January belonging to the last week of the previous year.
intYear = intYear - 1
End If
ElseIf bytMonth = cbytMonthDecember Then
If bytWeek = cbytFirstWeekOfAnyYear Then
' This is a late date of December belonging to the first week of the next year.
intYear = intYear + 1
End If
End If

ISO_WeekYearNumber = CStr(intYear) & cstrSeparatorYearWeek & Format(bytWeek, "00")

End Function

Public Function ISO_WeekNumber( _
ByVal datDate As Date) _
As Byte

' Calculates and returns week number for date datDate according to the ISO 8601:1988 standard.
' 1998-2000, Gustav Brock, Cactus Data ApS, CPH.
' May be freely used and distributed.

Const cbytFirstWeekOfAnyYear  As Byte = 1
Const cbytLastWeekOfLeapYear  As Byte = 53

Dim bytWeek                   As Byte
Dim bytISOThursday            As Byte
Dim datLastDayOfYear          As Date

bytWeek = DatePart("ww", datDate, vbMonday, vbFirstFourDays)

If bytWeek = cbytLastWeekOfLeapYear Then
bytISOThursday = Weekday(vbThursday, vbMonday)
datLastDayOfYear = DateSerial(Year(datDate), 12, 31)
If Weekday(datLastDayOfYear, vbMonday) >= bytISOThursday Then
' OK, week count of 53 is caused by leap year.
Else
' Correct for Access97/2000 bug.
bytWeek = cbytFirstWeekOfAnyYear
End If
End If

ISO_WeekNumber = bytWeek

End Function
``````
0

Author Comment

Thanks alot, I will test this
0

Author Comment

I'm running into an issue where only 1 week with the # of hours is being inserted into tblWork.  40 hour between 10/01/2012 and 10/31/2012 is only inserting one record  for week 44 with 10 hours of work vs. 4 records for week numbers 44 - 48 with each having 10 hrs.
0

LVL 48

Expert Comment

As I wrote, air code, thus you miss a MoveNext:

tblWork!Engineer = Me!Engineer
tblWork!Week = bytWeek
tblWork!Year = intYear
tblWork!Hours = Round(Me!TestHours / intWeeks, 0)
tblWork!Reason = Me!Order
tblWork!Note = "Test"
tblWork.Update
tblWork.MoveNext

/gustav
0

Author Comment

I'm getting Runtime 3021 " no current record with the movenext and on the

For bytWeek = 0 To intWeeks - 1  The bytWeek initializes as zero then is updated to the week number (i.e. 44) While the intWeeks remains = 4 so it's not stepping through the weeks.
0

Author Comment

It will incement if I use a
Do Until i = intWeeks
But the week number is not updating
0

LVL 48

Accepted Solution

Sorry, still air code. A variable was missing.
``````' The function modified (air code, not tested):

Dim datProjToTest       As Date
Dim datProjWitnessTest  As Date
Dim datWeek             As Date
Dim intWeek             As Integer
Dim intWeeks            As Integer
Dim bytWeek             As Byte
Dim intYear             As Integer

If IsDate(Me!ProjToTest) = True Then
datProjToTest = Me!ProjToTest
End If
If IsDate(Me!ProjWitnessTest) = True Then
datProjWitnessTest = Me!ProjWitnessTest
End If

' Do something if not having two useful dates.

intWeeks = DateDiff("ww", datProjToTest, datProjWitnessTest)

For intWeek = 0 To intWeeks - 1
' Retrieve ISO year and week.
Call ISO_WeekYearNumber(datWeek, intYear, bytWeek)
tblWork!Engineer = Me!Engineer
tblWork!Week = bytWeek
tblWork!Year = intYear
tblWork!Hours = Round(Me!TestHours / intWeeks, 0)
tblWork!Reason = Me!Order
tblWork!Note = "Test"
tblWork.Update
Next
tblWork.Close
``````
intWeek is the counter, intYear and bytWeek is the year and weeknumber.

/gustav
0

Author Comment

Ok, thanks alot
0

LVL 48

Expert Comment

You are welcome!

/gustav
0

Author Comment

How can I change the code so that any date(or a date in the first 4 days of the week) in a week following the week of the first / start date will distribute hours into that week number?

The original code would distribute 6 hours between 10/01/2012 - 10/10/2012 as 3 hours for week 39 and 3 hours for week 40.  Presently, the new routine / code distributes 6 hours between 10/01/2012 - 10/10/2012 as 6 hours for week 40.
0

LVL 48

Expert Comment

intWeeks = DateDiff("ww", datProjToTest, datProjWitnessTest, vbMonday, vbFirstFourDays)

However, that will still return 1 for your dates.
Thus, and also to prevent divide-by-zero errors, I believe this line should read

tblWork!Hours = Round(Me!TestHours / (1 + intWeeks), 0)

/gustav
0

Author Comment

Ok, thanks
0

LVL 48

Expert Comment

You are welcome!

/gustav
0

Featured Post

Suggested Solutions

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
In the article entitled Working with Objects – Part 1 (http://www.experts-exchange.com/Microsoft/Development/MS_Access/A_4942-Working-with-Objects-Part-1.html), you learned the basics of working with objects, properties, methods, and events. In Work…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.