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
=WEEKNUM
. 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.