CODEWITHSUNDEEP
vbadate
USER7423
USER7423

Reputation: 173

VBA Convert date to week number

In VBA I want to convert a date as 03/11/2017(DD/MM/YYYY) into the week number for that date.

Until now I have the following code: 

   'geting the date out of the string
    HeadlineTemp = Mid(VRHeadline, InStr(VRHeadline, "[") + 1, 10)
   'switch "." to "/"
    HeadlineTemp = Replace(HeadlineTemp, ".", "/")
   'convert to a date
    FristVRFirstKW = CDate(HeadlineTemp)

Now, I need a function to convert that date into the week number of the year. First week day is Monday.

Upvotes: 9

Views: 99998

Answers (8)

C02
C02

Reputation: 155

This alternate solution assumes the week number increases by 1 each Monday, and resets to 1 on the first Monday in January.

Dim WeekNumber as long
WeekNumber = Int(DateDiff("d", CDate("1/1/" & Year(DateAdd("d", 1 - Weekday(Date, 2), Date))), DateAdd("d", 1 - Weekday(Date, 2), Date)) / 7) + 1

Upvotes: 0

user7940167
user7940167

Reputation:

Cw = DatePart("ww", d, vbWednesday, vbFirstFullWeek)

ww -> for Calendar Week

d -> date variable

vbWednesday -> Starting day of week

vbFirstFullWeek -> year will be started from first 7

Upvotes: 0

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60414

Using VBA, to convert a date into an isoWeeknumber, you merely need the DatePart function (where DT is the date of interest):

isoWeekNumber = DatePart("ww", DT, vbMonday, vbFirstFourDays)

If you want to use other definitions than that specified in ISO 8601, investigate some of the other options for FirstDayOfWeek and FirstWeekOfYear

NOTE

As pointed out by @Mike85, there is a bug in DatePart (and also in the Format) function wherein Monday may be erroneously given a weeknumber of 53 when it should be 1.

There are a variety of workarounds.

In Excel 2013+ (Excel for Mac 2011+) you can use for the ISO Weeknumber:

isoWeekNumber = WorksheetFunction.isoWeekNum(dt)

For earlier versions, you can test the Monday and adjust it if necessary, or you can write a separate routine.

Upvotes: 8

mike85
mike85

Reputation: 631

Calculate ISO year using datepart with bugs workaround:

'Test 2007-12-31 should return W01Y2008

myDate = "2007-12-31"

ISOWeek = DatePart("ww", myDate, vbMonday, vbFirstFourDays)
Week1 = DatePart("ww", myDate, vbMonday, vbFirstFourDays)
Week2 = DatePart("ww", DateAdd("d", 7, myDate), vbMonday, vbFirstFourDays)
ISOYear = DatePart("yyyy", myDate, vbMonday, vbFirstFourDays)
Year1 = DatePart("yyyy", myDate, vbMonday, vbFirstFourDays)
Year2 = DatePart("yyyy", DateAdd("d", 7, myDate), vbMonday, vbFirstFourDays)

If ISOWeek = 53 And DatePart("ww", DateAdd("d", 7, myDate), vbMonday, vbFirstFourDays) = 2 Then
   ISOWeek = 1
End If

if ISOWeek = 1 And DatePart("yyyy", DateAdd("d", 7, myDate), vbMonday, vbFirstFourDays) > ISOYear Then
 ISOYear = ISOYear + 1
End If

MsgBox("W" & ISOWeek & "Y" & ISOYear)

' Result in W01Y2008

Upvotes: 0

Vityata
Vityata

Reputation: 43595

To make the Week Number with Monday as a first day, use the following:

WorksheetFunction.WeekNum(now, vbMonday)

Upvotes: 19

USER7423
USER7423

Reputation: 173

So, this is my final and working perfectly version

Public Function IsoWeekNumber(d As Date) As String

    Dim kwtemp As String

    kwtemp = DatePart("ww", d, vbMonday, vbFirstFourDays)

    If Len(kwtemp) = 1 Then kwtemp = "0" & kwtemp

    IsoWeekNumber = kwtemp

End Function

If Application.International(xlMDY) = True Then

HeadlineTemp = Mid(VRHeadline, InStr(VRHeadline, "[") + 1, 10)
HeadlineTemp = Replace(HeadlineTemp, ".", "/")
HeadlineTemp = Mid(HeadlineTemp, 4, 3) & Left(HeadlineTemp, 2) & Right(HeadlineTemp, 5)
VRFirstKW = CDate(HeadlineTemp)
HeadlineTempEndKW = Mid(VRHeadline, InStr(VRHeadline, "]") - 10, 10)
HeadlineTempEndKW = Replace(HeadlineTempEndKW, ".", "/")
HeadlineTempEndKW = Mid(HeadlineTempEndKW, 4, 3) & Left(HeadlineTempEndKW, 2) & Right(HeadlineTempEndKW, 5)
VREndKW = CDate(HeadlineTempEndKW)
VRKW = "KW" & IsoWeekNumber(VRFirstKW) & "-" & IsoWeekNumber(VREndKW) & "/" & Year(VREndKW)

    Else 'don't switch position of the month with days

    HeadlineTemp = Mid(VRHeadline, InStr(VRHeadline, "[") + 1, 10)
    HeadlineTemp = Replace(HeadlineTemp, ".", "/")
    VRFirstKW = CDate(HeadlineTemp)
    HeadlineTempEndKW = Mid(VRHeadline, InStr(VRHeadline, "]") - 10, 10)
    HeadlineTempEndKW = Replace(HeadlineTempEndKW, ".", "/")
    VREndKW = CDate(HeadlineTempEndKW)
    VRKW = "KW" & IsoWeekNumber(VRFirstKW) & "-" & IsoWeekNumber(VREndKW) & "/" & Year(VREndKW)

Upvotes: 0

mani
mani

Reputation: 3

WeekdayName( number, [abbreviate], [firstdayofweek] ) WeekdayName(2) Result: 'Monday'

WeekdayName(2, TRUE) Result: 'Mon'

WeekdayName(2, TRUE, vbMonday) Result: 'Mon'

Upvotes: 0

FunThomas
FunThomas

Reputation: 29592

Be carefull when it comes to week numbers as there are different definitions around. The Excel definition differs from the ISO definition. To get the ISO weeknumber use (copied From http://www.rondebruin.nl/win/s8/win001.htm)

Public Function IsoWeekNumber(d As Date) As Integer
    Dim d2 As Long
    d2 = DateSerial(Year(d - Weekday(d - 1) + 4), 1, 3)
    IsoWeekNumber = Int((d - d2 + Weekday(d2) + 5) / 7)
End Function

Upvotes: 5

Related Questions