So I convert a date range to week numbers. This is some sample data:
+-----------+------------+------------+--------------------+
| Name | From | To | ProjectDaysPerWeek |
+-----------+------------+------------+--------------------+
| Bob | 02/04/2021 | 20/04/2021 | 4 |
| Jessie | 05/05/2021 | 05/06/2021 | 5 |
| Lars | 15/06/2021 | 15/07/2021 | 3 |
| Kathy | 12/05/2021 | 22/06/2021 | 5 |
| Bob | 10/04/2021 | 16/04/2021 | 2 |
| Lars | 22/06/2021 | 30/06/2021 | 4 |
| Kim | 10/06/2021 | 30/06/2021 | 5 |
| Bob | 18/06/2021 | 24/06/2021 | 2 |
+-----------+------------+------------+--------------------+
And for the names that come up more than once (such as for Bob's and for Lars') I would want to extract the ProjectDaysPerWeek per
. That's what I am trying with this code:
Sub GetValuesPerWeekNum()
Dim ws As Worksheet
Dim d As Date
Set ws = ThisWorkbook.Sheets("Sheet1")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Counter = 1
ThisWorkbook.Sheets("Sheet2").Cells.Clear
For Each nm In ws.Range("A2:A" & LastRow)
For Each nme In ws.Range("A2:A" & LastRow)
If nm = nme And (nm.Address <> nme.Address) Then
wkNum = WorksheetFunction.WeekNum(ws.Range("B" & nm.Row))
wkNumTo = WorksheetFunction.WeekNum(ws.Range("C" & nm.Row))
For i = wkNum To wkNumTo
Counter = Counter + 1
WorkDaysPerWeek = ws.Range("D" & nm.Row)
ThisWorkbook.Sheets("Sheet2").Range("A" & Counter) = nm
ThisWorkbook.Sheets("Sheet2").Range("B" & Counter) = wkNum
ThisWorkbook.Sheets("Sheet2").Range("C" & Counter) = wkNumTo
ThisWorkbook.Sheets("Sheet2").Range("D" & Counter) = ws.Range("B" & nm.Row)
ThisWorkbook.Sheets("Sheet2").Range("E" & Counter) = ws.Range("C" & nm.Row)
ThisWorkbook.Sheets("Sheet2").Range("F" & Counter) = ws.Range("D" & nm.Row)
ThisWorkbook.Sheets("Sheet2").Range("G" & Counter) = i
Next i
End If
Next nme
Next nm
ThisWorkbook.Sheets("Sheet2").Range("A1") = "Name"
ThisWorkbook.Sheets("Sheet2").Range("B1") = "From Week"
ThisWorkbook.Sheets("Sheet2").Range("C1") = "To Week"
ThisWorkbook.Sheets("Sheet2").Range("D1") = "From Date"
ThisWorkbook.Sheets("Sheet2").Range("E1") = "To Date"
ThisWorkbook.Sheets("Sheet2").Range("F1") = "Value"
ThisWorkbook.Sheets("Sheet2").Range("G1") = "Week Number"
End Sub
However, this produces duplicate results as you can see in the results here:
+------+-----------+---------+------------+------------+-------+-------------+
| Name | From Week | To Week | From Date | To Date | Value | Week Number |
+------+-----------+---------+------------+------------+-------+-------------+
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 14 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 15 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 16 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 17 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 14 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 15 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 16 |
| Bob | 14 | 17 | 02/04/2021 | 20/04/2021 | 4 | 17 |
| Lars | 25 | 29 | 15/06/2021 | 15/07/2021 | 3 | 25 |
| Lars | 25 | 29 | 15/06/2021 | 15/07/2021 | 3 | 26 |
| Lars | 25 | 29 | 15/06/2021 | 15/07/2021 | 3 | 27 |
| Lars | 25 | 29 | 15/06/2021 | 15/07/2021 | 3 | 28 |
| Lars | 25 | 29 | 15/06/2021 | 15/07/2021 | 3 | 29 |
| Bob | 15 | 16 | 10/04/2021 | 16/04/2021 | 2 | 15 |
| Bob | 15 | 16 | 10/04/2021 | 16/04/2021 | 2 | 16 |
| Bob | 15 | 16 | 10/04/2021 | 16/04/2021 | 2 | 15 |
| Bob | 15 | 16 | 10/04/2021 | 16/04/2021 | 2 | 16 |
| Lars | 26 | 27 | 22/06/2021 | 30/06/2021 | 4 | 26 |
| Lars | 26 | 27 | 22/06/2021 | 30/06/2021 | 4 | 27 |
| Bob | 25 | 26 | 18/06/2021 | 24/06/2021 | 2 | 25 |
| Bob | 25 | 26 | 18/06/2021 | 24/06/2021 | 2 | 26 |
| Bob | 25 | 26 | 18/06/2021 | 24/06/2021 | 2 | 25 |
| Bob | 25 | 26 | 18/06/2021 | 24/06/2021 | 2 | 26 |
+------+-----------+---------+------------+------------+-------+-------------+
Any help is appreciated.
Bookmarks