Conditional Loop with random number then checking outcome

I have a random number generator as follows: Outputs 2 or 4 numbers on Sheet 2 in row J I would then like to check against values in column k to see how many times that number has come up and if too many to randomise again.

The criteria is Between 1 and 15 of month every number has to come up once Between 16 and 26 of month every number has to come up twice then after that any can come up. So pretty much each number needs to come up minimum twice per month.

I am really struggling with how to do it because each time i have tried something i just cant seem to put the whole thing in a loop.

Any assistance would be greatly appreciated.

Dim CountCells
Dim RandCount
Dim LastRow
Dim Counter1
Dim COUNTER2
Dim datetest As Integer

Application.ScreenUpdating = False
Worksheets("Calculation").Select
Range("A1").Select
CountCells = WorksheetFunction.Count(Range("A:A"))
    If CountCells = 0 Then Exit Sub
    On Error Resume Next
    Application.DisplayAlerts = False
    RandCount = 2
On Error GoTo 0
Application.DisplayAlerts = True
RandCount = Int(RandCount)
If Int(RandCount) <= 0 Or RandCount = False Then Exit Sub
If RandCount > CountCells Then
MsgBox "Requested quantity of numbers is greater than quantity of available data"
Exit Sub
End If

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("B:C").ClearContents

Range("Reference!c:c").ClearContents
Range("Reference!J:J").ClearContents

Range("B1") = 1
Range(Cells(1, 2), Cells(LastRow, 2)).DataSeries , Step:=1
Range(Cells(1, 1), Cells(LastRow, 3)).sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("C1") = "=RAND()"
Range("C1").Copy Range(Cells(1, 3), Cells(LastRow, 3))
Range(Cells(1, 1), Cells(LastRow, 3)).sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Counter1 = 1
COUNTER2 = 1
Range("J1:J58").ClearContents
Do Until Counter1 > RandCount
If IsNumeric(Cells(COUNTER2, 1).Value) And Cells(COUNTER2, 1).Value <> Empty Then
Range("Reference!J" & Counter1) = Cells(COUNTER2, 1)

Counter1 = Counter1 + 1
End If
COUNTER2 = COUNTER2 + 1
Loop