如何滚动 WeekNum 如果年份不是在特定的工作日（如星期五）开始

Question

I am currently working on a excel macro which generates Weekly data. I have to prepare multiple reports where my Week starting day is different eg if for one report my week start day is "Friday" whereas for other report the week start day is "Monday"

Right now, I am doing this in multiple steps:

1. First I am getting all data from source excel and adding a formula to get all records in a particular week. I have considered "Friday" as my first day of week.

2. I arranged the records in descending order and get the unique value for each AZ column. This way I got the last record from each week, which is what I was looking.

Code I am using for this is as follows:

    Range("Data").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Range("$A$1:$A$2"), _
    CopyToRange:=Range("$BB$4:$BD$4")

    FilterDataLastRow = Cells.Find(What:="*", _
    After:=Range("BA999999"), _
    LookAt:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, _
    MatchCase:=False).Row

    ' Sort data in descending order of date
     ' Range("WeeklyFilteredData").Sort Key1:=Range("$BB$4:$BB$999999"), Order1:=xlDescending, Header:=xlYes
       Range("AW4:BE999999").Sort Key1:=Range("BC4:BC999999"), order1:=xlDescending, Header:=xlYes

    ' Assign Unique Key for each record row. We are using RowNum for same
        Range("BA5:BA" & FilterDataLastRow).Formula = "=ROW(RC[-2])"

    ' Assign SearchKey to filter Out all the data belonging to same week
        Range("AZ5:AZ" & FilterDataLastRow).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],15),""00""))"

    ' Get all data in User View
         Range("A5:A" & FilterDataLastRow).Formula = "=VLOOKUP(RC[51],C[51]:C[55],2,FALSE)"
         Range("B5:B" & FilterDataLastRow).Formula = "=VLOOKUP(RC[50],C[50]:C[54],3,FALSE)"
         Range("C5:C" & FilterDataLastRow).Formula = "=VLOOKUP(RC[49],C[49]:C[53],4,FALSE)"
         Range("E5:E" & FilterDataLastRow).Formula = "=VLOOKUP(RC[47],C[47]:C[51],5,FALSE)"

         Cells.RemoveDuplicates Columns:=Array(1)

This was working perfectly fine till WEEKNUM 53. January 2020 started on Wednesday and this was considered a WEEKNUM "1" which is not correct for my report.

Currently I am getting my Output as shown below:

I need to modify my Code to skip data for 12/31/2019 (Highlighted in red) as this data will be calculated as part of week which is ending on 01/02/2020.

Please suggest a better way to update my code to enter code here

[Update: 07 January 2020] ANSWER

I figured out a way to achieve my end result. But I know there is still better way to do same thing and hence I am keeping this question open for better approach.

Here is what I did: 1. Retrieve MONTH, DAY and WEEKDAY from given date

Range("AW5:AW" & FilterDataLastRow).Formula = "=MONTH(RC[6])"
Range("AX5:AX" & FilterDataLastRow).Formula = "=DAY(RC[5])"
Range("AY5:AY" & FilterDataLastRow).Formula = "=WEEKDAY(RC[4],16)"

2. Now added a for loop. I tried to explain each of my step in comments inside code.

    For i = 5 To FilterDataLastRow ' Check for records with Month = 1 And DAY is 1-6 and WEEKDAY < 6 If Range("AW" & i).Value = 1 And Range("AX" & i).Value < 7 Then CurrYear = Year(Range("BC" & i).Value) PrevYear = CurrYear - 1 PrevYearLastDay = "12/31/" & PrevYear Range("AV" & i).Value = PrevYearLastDay 'Get the Day of Weel on 31st December of Previous Year Range("AU" & i).Value = "=WEEKDAY(RC[1],16)" 'Calculate Number of Days remaining for new week to start DaysRemForNewWeek = 8 - Range("AU" & i).Value 'Calculate Date of First Friday of Current Year Range("AT" & i).Value = PrevYearLastDay + DaysRemForNewWeek 'Compare all the dates prior to first Friday and rollover WeekNum from last year for these dates If Range("BC" & i).Value < Range("AT" & i).Value Then Range("AZ" & i).Formula = "=(TEXT(RC[-4],""yyyy""))&(TEXT(WEEKNUM(RC[-4],16),""00""))" Else Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))" End If Else Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))" End If Next i

Answer 1

What is your definition of a Week given a particular start day?

If it is the first full week of the year starting with that date, then you can derive it more easily from the VBA DatePart function, eg

DatePart("ww", myDate, vbFriday, vbFirstFullWeek)

If you need to have this as a function or part of a formula on your worksheet, use it as a UDF instead of the worksheet WEEEKNUM function which is not as flexible. Or, better yet, construct the year/wknum string in VBA using the vba Format function and write that string to the worksheet.

For example:

Function yrWkNum(dt As Date) As String
    yrWkNum = Year(dt) & Format(DatePart("ww", dt, vbFriday, vbFirstFullWeek), "00")
End Function

Answer 2

I figured out a way to achieve my end result. But I know there is still better way to do same thing and hence I am keeping this question open for better approach.

Here is what I did: 1. Retrieve MONTH, DAY and WEEKDAY from given date

Range("AW5:AW" & FilterDataLastRow).Formula = "=MONTH(RC[6])"
Range("AX5:AX" & FilterDataLastRow).Formula = "=DAY(RC[5])"
Range("AY5:AY" & FilterDataLastRow).Formula = "=WEEKDAY(RC[4],16)"

2. Now added a for loop. I tried to explain each of my step in comments inside code.

    For i = 5 To FilterDataLastRow ' Check for records with Month = 1 And DAY is 1-6 and WEEKDAY < 6 If Range("AW" & i).Value = 1 And Range("AX" & i).Value < 7 Then CurrYear = Year(Range("BC" & i).Value) PrevYear = CurrYear - 1 PrevYearLastDay = "12/31/" & PrevYear Range("AV" & i).Value = PrevYearLastDay 'Get the Day of Weel on 31st December of Previous Year Range("AU" & i).Value = "=WEEKDAY(RC[1],16)" 'Calculate Number of Days remaining for new week to start DaysRemForNewWeek = 8 - Range("AU" & i).Value 'Calculate Date of First Friday of Current Year Range("AT" & i).Value = PrevYearLastDay + DaysRemForNewWeek 'Compare all the dates prior to first Friday and rollover WeekNum from last year for these dates If Range("BC" & i).Value < Range("AT" & i).Value Then Range("AZ" & i).Formula = "=(TEXT(RC[-4],""yyyy""))&(TEXT(WEEKNUM(RC[-4],16),""00""))" Else Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))" End If Else Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))" End If Next i