Randomly distribute a range values to a bigger range - vba

Question

I'm building an automatic calendar project.
Input information is a task list for the month/year and an idea is to distribute exact values from the input list randomly over the output range.
I thought using a recursive vba function
Sub distributeRandomly()
Dim InRng as Range
Dim OutRng as Range
Dim distributePercent as Single
Set InRng=Application.InputBox("Select input range",Type:=8)
Set OutRng=Application.Input("Select output range",Type:=8)
distributePercent=InRng.count/OutRng.count
distributeRandomlyRec(InRng,OutRng,distributePercent)
End Sub
Function distributeRandomlyRec(InRng As Range,OutRng as range,distributePercent as Single)
Dim i1 As Integer
Dim i2 As Integer
if OutRng.count=0 or InRng.count=0 Then
Exit Function
Else
Randomize
If distributePercent <= Rnd Then
Randomize
i1=int(OutRng.count*Rnd+1)
Randomize
i2=int(InRng.count*Rnd+1)
OutRng.Cells(i1).value=InRng.Cells(i2).value
##Here i stacked to define a new ranges without the choosen cells i1 and i2
##Maybe convert old range to array , delete a value and then
##Transpose() an array to a new range ?
##NewOutRng = ?
##NewInRng = ?
if NewOutRng.count=0 or NewInRng.count=0 Then
Exit Function
else
distributePercent=NewInRng.count/NewOutRng.count
distributeRandomlyRec(NewInRng,NewOutRnge,distributePercent)
End If
End Function

Answer 1

fixed the code - no recursive version , tested
Sub distributeRandomly()
Dim InRng As Range
Dim OutRng As Range
Dim inCollection As New Collection
Dim outCollection As New Collection
Dim i1 As Integer
Dim i2 As Integer
Dim distributePercent As Single
Set InRng=Application.InputBox("Select input range",Type:=8)
Set OutRng=Application.InputBox("Select output range",Type:=8)
Dim c As Range
For Each c In InRng
inCollection.Add c.Value
Next
While inCollection.Count > 0
If (OutRng.Count - outCollection.Count) > 0 Then
Randomize
distributePercent = inCollection.Count / (OutRng.Count - outCollection.Count)
If distributePercent >= Rnd Then
Randomize
i1 = Int(inCollection.Count * Rnd + 1)
outCollection.Add inCollection(i1)
inCollection.Remove (i1)
Else
outCollection.Add (vbNullString)
End If
End If
Wend
For i2 = 1 To outCollection.Count
OutRng.Cells(1, i2).Value = outCollection(i2)
Next
End Sub