Random value must be unique depending on date range

[Retroshift]

Hello, I have a button that creates 12 month sheets for a specific year that is entered into an inputbox. The code below enters values (coming from a master sheet list) randomly every workday per month sheet created.
I would like to have only unique random values per week, and a minimum of 2 and maximum of 4 of each value per month range.

I added an example screenshot of a month sheet where my RandBetween code wrongly enters the same values consecutively (highlighted in red).
Anyone knows how to alter the code accordingly?

For Each rng In Range("B1").Resize(1, Day(DateSerial(yr, i + 1, 1) - 1))
    If Weekday(rng) <> 1 And Weekday(rng) <> 7 And CLng(rng) <> Application.Lookup(CLng(rng), datearray) Then
    Range(rng.Rows(4), rng.Rows(4)).Value = Ary(WorksheetFunction.RandBetween(1, k), 1)
    End If
Next

 

[Retroshift]

Anyone?

 

[Retroshift]

Up

 

[Retroshift]

This is what I got so far but I cannot seem to make every single week contain unique random values. Any ideas?

                    If rng = vbMonday Then
                    Set weekrange = rng.Offset(3).Resize(1, 5)
                    ElseIf rng = vbTuesday Then
                    Set weekrange = rng.Offset(3).Resize(1, 4)
                    ElseIf rng = vbWednesday Then
                    Set weekrange = rng.Offset(3).Resize(1, 3)
                    ElseIf rng = vbThursday Then
                    Set weekrange = rng.Offset(3).Resize(1, 2)
                    ElseIf rng = vbFriday Then
                    Set weekrange = rng.Offset(3)
                    End If
                    For Each wkrng In weekrange
                    Randomval = Ary(WorksheetFunction.RandBetween(1, k), 1)
                    Do While Application.WorksheetFunction.CountIf(weekrange, Randomval) >= 1
                    Randomval = Ary(WorksheetFunction.RandBetween(1, k), 1)
                    Loop
                    wkrng.Value = Randomval
                    Next