Week Number using VBA in Excel

G

Guest

Hi Can you please help to get this script run in excel. as I am finding
difficulties in running.

Public Function ISOWeekNum(AnyDate As Date, _
Optional WhichFormat As Variant) As Integer
'
' WhichFormat: missing or <> 2 then returns week number,
' = 2 then YYWW
'
Dim ThisYear As Integer
Dim PreviousYearStart As Date
Dim ThisYearStart As Date
Dim NextYearStart As Date
Dim YearNum As Integer

ThisYear = Year(AnyDate)
ThisYearStart = YearStart(ThisYear)
PreviousYearStart = YearStart(ThisYear - 1)
NextYearStart = YearStart(ThisYear + 1)
Select Case AnyDate
Case Is >= NextYearStart
ISOWeekNum = (AnyDate - NextYearStart) \ 7 + 1
YearNum = Year(AnyDate) + 1
Case Is < ThisYearStart
ISOWeekNum = (AnyDate - PreviousYearStart) \ 7 + 1
YearNum = Year(AnyDate) - 1
Case Else
ISOWeekNum = (AnyDate - ThisYearStart) \ 7 + 1
YearNum = Year(AnyDate)
End Select

If IsMissing(WhichFormat) Then
Exit Function
End If
If WhichFormat = 2 Then
ISOWeekNum = CInt(Format(Right(YearNum, 2), "00") & _
Format(ISOWeekNum, "00"))
End If

End Function
 
R

Rick Rothstein \(MVP - VB\)

And those difficulties you are having are what? The more details you give
us, the better able we are to figure out how to help you.

It looks like you copied John Green's ISOWeekNum function correctly... did
you also copy the YearStart function which the ISOWeekNum function depends
on?

Rick
 
R

Ron Rosenfeld

Hi Can you please help to get this script run in excel. as I am finding
difficulties in running.

Public Function ISOWeekNum(AnyDate As Date, _
Optional WhichFormat As Variant) As Integer
'
' WhichFormat: missing or <> 2 then returns week number,
' = 2 then YYWW
'
Dim ThisYear As Integer
Dim PreviousYearStart As Date
Dim ThisYearStart As Date
Dim NextYearStart As Date
Dim YearNum As Integer

ThisYear = Year(AnyDate)
ThisYearStart = YearStart(ThisYear)
PreviousYearStart = YearStart(ThisYear - 1)
NextYearStart = YearStart(ThisYear + 1)
Select Case AnyDate
Case Is >= NextYearStart
ISOWeekNum = (AnyDate - NextYearStart) \ 7 + 1
YearNum = Year(AnyDate) + 1
Case Is < ThisYearStart
ISOWeekNum = (AnyDate - PreviousYearStart) \ 7 + 1
YearNum = Year(AnyDate) - 1
Case Else
ISOWeekNum = (AnyDate - ThisYearStart) \ 7 + 1
YearNum = Year(AnyDate)
End Select

If IsMissing(WhichFormat) Then
Exit Function
End If
If WhichFormat = 2 Then
ISOWeekNum = CInt(Format(Right(YearNum, 2), "00") & _
Format(ISOWeekNum, "00"))
End If

End Function
Click to expand...

What problems are you having?

There are simpler algorithms.

For example, to just get the ISOWeeknumber:

==================================
Function ISOWeeknum(dt As Date) As Integer
ISOWeeknum = DatePart("ww", dt, vbMonday, vbFirstFourDays)
If ISOWeeknum > 52 Then
If DatePart("ww", dt + 7, vbMonday, vbFirstFourDays) = 2 Then
ISOWeeknum = 1
End If
End If
End Function
====================================
--ron
 
H

Hans Terkelsen

Ron Rosenfeld said:
What problems are you having?

There are simpler algorithms.

For example, to just get the ISOWeeknumber:

==================================
Function ISOWeeknum(dt As Date) As Integer
ISOWeeknum = DatePart("ww", dt, vbMonday, vbFirstFourDays)
If ISOWeeknum > 52 Then
If DatePart("ww", dt + 7, vbMonday, vbFirstFourDays) = 2 Then
ISOWeeknum = 1
End If
End If
End Function
====================================
--ron
Click to expand...

Hi Ron!

Your ISOWeeknum(dt As Date) has the advantage of sidestepping the bug in Datepart in a clear way.
But some of the errors remain.
Sun 2 jan 2101 still gives week 53, which should be 52 like Sat 1 jan 2101.
A bit into the future, I'll admit.

Staying with Datepart there is this:

Function ISOWknum(d As Date) '25/12/1899-26/12/9999
ISOWknum = DatePart("ww", ((d + 5) \ 7) * 7, 2, 2)
End Function

It looks at the Saturday of the same week.

Otherwise I'm quite proud of this

Function WkIso(d) '..1/1/100-31/12/9999..
WkIso = ((((d + 692501) \ 7 Mod 20871) * 28 + 4383) Mod 146096 Mod 1461) \ 28 + 1
End Function

It is very fast, doesn't need datefunctions.

Hans.
 
R

Ron Rosenfeld

Hi Ron!

Your ISOWeeknum(dt As Date) has the advantage of sidestepping the bug in Datepart in a clear way.
But some of the errors remain.
Sun 2 jan 2101 still gives week 53, which should be 52 like Sat 1 jan 2101.
A bit into the future, I'll admit.

Staying with Datepart there is this:

Function ISOWknum(d As Date) '25/12/1899-26/12/9999
ISOWknum = DatePart("ww", ((d + 5) \ 7) * 7, 2, 2)
End Function

It looks at the Saturday of the same week.

Otherwise I'm quite proud of this

Function WkIso(d) '..1/1/100-31/12/9999..
WkIso = ((((d + 692501) \ 7 Mod 20871) * 28 + 4383) Mod 146096 Mod 1461) \ 28 + 1
End Function

It is very fast, doesn't need datefunctions.

Hans.
Click to expand...

Very good Hans!

I was not aware of that BUG in DatePart. (And, apparently, neither was
Microsoft, as the only BUG they mention is the one for Mondays).

I like both of your workarounds. The one I came up with is not as fast as
yours, but it does clarify the bugs, I think. I haven't tested it yet, though:

========================================
Function ISOWeeknum(dt As Date) As Integer
ISOWeeknum = DatePart("ww", dt + (Weekday(dt, vbMonday) <> 1), _
vbMonday, vbFirstFourDays)
If DatePart("ww", dt + 7, vbMonday, vbFirstFourDays) = 2 _
Then ISOWeeknum = 1
End Function
===========================================
--ron
 
H

Hans Terkelsen

Ron Rosenfeld said:
Very good Hans!

I was not aware of that BUG in DatePart. (And, apparently, neither was
Microsoft, as the only BUG they mention is the one for Mondays).

I like both of your workarounds. The one I came up with is not as fast as
yours, but it does clarify the bugs, I think. I haven't tested it yet, though:

========================================
Function ISOWeeknum(dt As Date) As Integer
ISOWeeknum = DatePart("ww", dt + (Weekday(dt, vbMonday) <> 1), _
vbMonday, vbFirstFourDays)
If DatePart("ww", dt + 7, vbMonday, vbFirstFourDays) = 2 _
Then ISOWeeknum = 1
End Function
===========================================
--ron
Click to expand...

Ron,
if you will accept my testresult, your function is true for all (VB) dates
4 jan 100 - 24 dec 9999!
And still clear (enough) :)
You go back 1 day except on mondays.
I also looked for a simple modification,
but could not come up with anything better.
OK and thanks, Hans.
 
R

Ron Rosenfeld

Ron,
if you will accept my testresult, your function is true for all (VB) dates
4 jan 100 - 24 dec 9999!
And still clear (enough) :)
You go back 1 day except on mondays.
I also looked for a simple modification,
but could not come up with anything better.
OK and thanks, Hans.
Click to expand...

Thank you, Hans.

I wonder if MS will ever correct these bugs. They've been around for a long
time.
--ron
 
D

Dallman Ross

Ron Rosenfeld said:
I wonder if MS will ever correct these bugs. They've been around
for a long time.
Click to expand...

Somehow I doubt it. By way of example, In another Office app that
I use, Outlook 2002 (and I have been using Outlook since 1996),
there is still a bug where no test for race condition is done
before the message that is currently in focus (highlighted) is
acted upon.

So, for example, if I have a message highlighted and am about to
delete it and am pressing the Delete key, or am about to move it to
some folder and am dragging it, and at that moment another message
comes in, the other message gets deleted or moved instead! I find
this uncorrected longstanding bug astonishingly, incorrigibly bad.
I wouldn't mind knowing if it's still in the current version.

Dallman
 
H

Hans Terkelsen

Ron de Bruin said:
Hi Hans

I not test your function but do you get the same results as the VBA function and the formulas on my page
http://www.rondebruin.nl/weeknumber.htm#information

See the Calendar workbook
Click to expand...

Hi Ron d B!

I have been slow to answer, sorry.

Yes, I get the same results as your function and formula gives.
The only difference is a few days at the start of the dates.
We can consider Daniel Mahers function as a reference.

My checker runs through all the dates, and compares the putative(?) ISO weeknumber function to a running week counter that follows
the appropriate rules.
Takes only a few minutes in VB.

DM's function is true 4/1/100-31/12/9999 according to that checker.
The first 3 days it errors, if anybody should care.
Ptolemy maybe:)

Your worksheet function likewise, 2/1/1900-31/12/9999, agrees with the others.

Did you want a second opinion on the Calendar workbook?
Useful and correct :)
A reverse weeknumber function, from ISOweekyear and weeknumber to a date, agrees with your date for first monday 1901 to 9999, but
not for 1900 as you know. Yours is the correct date.
Another way to sidestep the 29/2/1900 issue, is to add 400 years to the year in formulas.
All dates, weekdays, weeknumbers repeat after 400 years, and 29/2/2300 does not exist in Excel.
Then the calendar could go back to 1500!

I think I'll keep it as it is, Thankyou Ron, Greetings Hans.
 
R

Ron de Bruin

Thank for your reply Hans

I an updating all my webpages on the moment.
When I do the Week number and ISO page I will check all the stuff on it and maybe do a small update

Have a nice day
 
G

Guest

What I have done I pasted ISO week & ISO year start script into modules &
after that I saved that file. After opening the same file have entered some
dates into excel but it is not giving me week number.

Can you please guide me how to do it as I am not the VB script expert.

Can you also let me know is that possible that I can get week number in
desired column number.

Appreciate your help.

Kam.
 
H

Hans Terkelsen

Ron de Bruin said:
Thank for your reply Hans

I an updating all my webpages on the moment.
When I do the Week number and ISO page I will check all the stuff on it and maybe do a small update

Have a nice day
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
Click to expand...

You too, Ron.

I would be pleased if you included my WkIso() function,
but you might decide that it looks too cryptic.
It had to work with integers, to avoid small binary inaccuracies like
1.2-1.1-0.1 <> 0, and that made for big unrecognizeable numbers.
I suspect that the Datepart bug comes from a related problem.

Greetings, Hans.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VB6 to VB.Net Conversion 1
PowerPoint Shuffle (swap) objects on PPT slides with the same name only 0
Excel VBA - counting cells by colors and names to it in two different rows. 0
Week Number Format 4
Mysterious SQL statement hating tables 3
please help.is it possible re-edit macro to convert text like1530-2200 to time format automatically? 1
Increment Month/Year in "mmm-yy" format 2
Excel VBA 1

Top