Randomize where a random number is limited to the number of repeats

[brianfosterblack]

I have this code to select a random number up to the value I enter in Cell A1
In Cell B1 I enter the number of rows I want to fill.
This VBA ensures that each number is only selected once
The problem I have is that sometimes Cell B1 is a larger number than cell B2 so I want to be able to enter in cell C1 (or enter a formula) the maximum number of times a number can be repeated
so if the maximum number I want is 10 but I want to fill 20 rows, then in cell C1 I will enter 2 which means the numbers 1 to 10 can be repeated twice.
Is there any way of adjusting this code to allow this.

Option Explicit
Option Base 1
Public jj As Long
Sub Resample() ' with the doublesort,numbers randomly found between the range can only appear once
Dim i As Long
Dim hold(10000) As Single, Hold2(10000) As Single

Application.Calculation = xlCalculationManual
Range("NumberRange").ClearContents
Range("A2").Select
Randomize

For i = 1 To Range("A1").Value
Hold2(i) = i
Next i
For jj = 1 To 1
For i = 1 To Range("A1").Value
hold(i) = Rnd
Next i
Call DoubleSort(Range("A1").Value, hold, Hold2)
For i = 1 To Range("B1").Value
ActiveCell.Offset(1, 0).Select
ActiveCell = Hold2(i)
Next i
Next jj
Application.Calculation = xlCalculationAutomatic
Range("A1").Select
End Sub

'***********************************************************************
'* Sorting Process - Sort array y based on array x *
'***********************************************************************

Sub DoubleSort(n As Long, x() As Single, y() As Single)
Dim xTemp As Double
Dim yTemp As Double
Dim i As Long
Dim j As Long

For j = 2 To n
xTemp = x(j)
yTemp = y(j)
For i = j - 1 To 1 Step -1
If (x(i) <= xTemp) Then GoTo 10
x(i + 1) = x(i)
y(i + 1) = y(i)
Next i
i = 0
10 x(i + 1) = xTemp
y(i + 1) = yTemp
Next j

End Sub

 

[brianfosterblack]

Sorry, in the above question cell B2 should be Cell A1

 

[jasonb75]

An alternative approach, this enters some temporary random values into column B to help with the process, so if you already have data there then the code will need to be changed to work with a different column.

Option Explicit
Sub Random_Number_List()
Dim rng As Range
Range("NumberRange").ClearContents
Set rng = Range("A2").Resize(Range("A1").Value, 1)
With rng
    .FormulaR1C1 = "=ROUNDUP(ROWS(R2C1:RC1)*R1C2/R1C1,0)"
    .Value = .Value
    With .Offset(, 1)
        .Formula = "=RAND()"
        With ActiveWorkbook.ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=rng.Offset(, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange rng.Resize(, 2)
            .Header = xlYes
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .ClearContents
    End With
End With
End Sub

 

[AlphaFrog]

[color=darkblue]Sub[/color] Resample2()
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], lMax [color=darkblue]As[/color] [color=darkblue]Long[/color], lCount [color=darkblue]As[/color] [color=darkblue]Long[/color], lRepete [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] arr [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Static[/color] bRandomized [color=darkblue]As[/color] [color=darkblue]Boolean[/color]
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] bRandomized [color=darkblue]Then[/color] Randomize: bRandomized = [color=darkblue]True[/color]
    
    lMax = Range("A1").Value
    lCount = Range("B1").Value
    lRepete = Application.WorksheetFunction.RoundUp(lCount / lMax, 0) [color=green]'Range("C1").Value[/color]
    
    [color=darkblue]ReDim[/color] arr(1 [color=darkblue]To[/color] lCount)
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] lCount
        [color=darkblue]Do[/color]
            DoEvents
            arr(i) = Int(lMax * Rnd + 1)
        [color=darkblue]Loop[/color] [color=darkblue]While[/color] Application.Count(Application.Match(arr, Array(arr(i)), 0)) > lRepete
    [color=darkblue]Next[/color] i
    
    Range("NumberRange").ClearContents
    Range("A3").Resize(lCount).Value = Application.Transpose(arr)
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[brianfosterblack]

Thank you,

This works perfectly. Fortunately I had no data in column B

 

[brianfosterblack]

sorry but I am running into a problem

If I have 10 numbers to fill 40 rows, then each number 1 to 10 is repeated 4 times which is what I am looking for.
but if I have 35 rows to fill, some numbers are not repeated and some are repeated well over 4 times.
What should happen is such a case is that some numbers will be repeated a maximum of 4 times but some will only repeat 3 times

 

[jasonb75]

What should happen is such a case is that some numbers will be repeated a maximum of 4 times but some will only repeat 3 times

As far as I can see, that is what is happening.

I can't see that it is possible for any number to be entered too many times unless the previous run of the code has exceeded the range defined as "NumberRange", leaving some previous values behind.
The only potential issue that I can see in such cases is a bias to certain numbers due to the way I have done the rounding.

Have you tried the code that AlphaFrog has provided to see if it works any different?

 

[brianfosterblack]

Hi Jasonb75,

It is Alphfrog's code I am running.

Your code stuck on this line of code
.SortFields.Add2 Key:=rng.Offset(, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 

[Rick Rothstein]

Question: If you have 10 numbers that need to be randomized, do all 10 of them have to be used once before any are allowed to repeat? For example, if you have 10 numbers to randomize, a maximum repeat of 2 and 15 cells to put them in, would this be an acceptable result...

1
1
2
2
3
3
4
4
5
5
6
6
7
7
8

or does 9 and 10 have to be in there before any of the repeats are allowed to occur?

 

[brianfosterblack]

Hi Jason,

No what I do need is for all 10 numbers to be used but they do not all have to be used once before they repeat again. I am keeping the numbers low for this excercise but typically I am working with number ranges from about 35 to 300 and the row numbers vary between 140 and 600
Sometimes I have less rows than numbers in which case the number must only show once and some numbers will be omitted but often the rows are more than the number range but I want to prevent seeing some numbers repeated multiple times and some numbers not being used more than once or at all.
It is a good point you make and what if we do the formula that if we just run the original code for one round of numbers using each number once and then use the formula that if A1/B1 >1 then run the code for the full number of rows equal to A1 and repeat it again by the result of the formula, just starting at the end of the previous range.