Generating multiple random number sets with even distribution

[Naxos2032]

Hey all.

I’m pretty new to all this VBA still and was looking for a little help. So far, I’ve managed to write a random number generator that produces multiple sets with no repeating numbers per a set.

Now, to step it up a notch, I’m trying to create an even distribution of the numbers generated which is where I could use a hand. Here’s my current code:

Option Base 1
Sub RandomNumberStrings()

Dim rndno As String, strg As String, msg1 As String
Dim r1() As String, r2() As String
Dim l As Integer, u As Integer, NoStr As Integer, SetCount As Integer
Dim i As Integer, j As Integer, k As Integer, m As Integer, x As Integer
Dim a As Variant

l = InputBox(Prompt:="Enter Starting Range.", Title:="Start", Default:=1) 'Low number in range
u = InputBox(Prompt:="Enter Ending Range.", Title:="End", Default:=10) 'High number in range
x = 3 ' First Row of output
SetCount = InputBox(Prompt:="Enter Amount of Sets.", Title:="Sets", Default:=100) '# of random number sets
NoStr = InputBox(Prompt:="Enter Amount of Results.", Title:="Results", Default:=5) '# of results to generate

ReDim r1(1 To NoStr)
ReDim r2(1 To SetCount)

For i = 1 To SetCount
    Do
        For j = l To NoStr
            Do
            rndno = Int((u - l + 1) * Rnd + l)
                For k = 1 To j
                    If rndno = r1(k) Then
                        Exit For
                    ElseIf k = j Then
                        Exit Do
                    End If
                Next k
            Loop
            r1(j) = rndno
        Next j
    
    strg = Join(r1, ",")
    ReDim r1(NoStr)

        For m = 1 To i
            If strg = r2(m) Then
                Exit For
            ElseIf m = i Then
                Exit Do
            End If
        Next m
    Loop

r2(i) = strg

Next i

For Each a In r2
    Range("B" & x) = a
    x = x + 1
Next a

Range("B3:B65536").TextToColumns Destination:=Range("B3:B65536"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
    TrailingMinusNumbers:=True

End Sub

Now, as an example I ran that with the ranges set at 1-10, the amount of sets to 100 and 5 results per a set. And at the end I got the following list:

1 = 50 x
2 = 45 x
3 = 56 x
4 = 53x
5 = 61x
6 = 54 x
7 = 47x
8 = 47x
9 = 42x
10 = 45x

Equalling 500 numbers generated as intended, but my target is to get every number with an equal frequency. Is it possible?

Any help/code/link to a forum with examples would be most appreciated.

 

[Phox]

I would approach this by generating the desired set of numbers first, assigning each number an rnd number, and then sorting the first set based on the values of the second set.

 

[Naxos2032]

Hmm, got any examples I could take a look at and see how its done?

 

[Phox]

Something like this should work. It would be a little simpler if I had written from scratch, but just edited yours for comparison.

Sub RandomNumberStrings()

Dim rndno As String, strg As String, msg1 As String
Dim r1() As Long, r2() As String
Dim l As Integer, u As Integer, NoStr As Integer, SetCount As Integer
Dim i As Integer, j As Integer, k As Integer, m As Integer, x As Integer
Dim a As Variant

l = InputBox(Prompt:="Enter Starting Range.", Title:="Start", Default:=1) 'Low number in range
u = InputBox(Prompt:="Enter Ending Range.", Title:="End", Default:=10) 'High number in range
x = 3 ' First Row of output
SetCount = InputBox(Prompt:="Enter Amount of Sets.", Title:="Sets", Default:=100) '# of random number sets
NoStr = InputBox(Prompt:="Enter Amount of Results.", Title:="Results", Default:=5) '# of results to generate

ReDim r1(0 To SetCount) As Long
ReDim r2(1 To SetCount)

For i = 1 To SetCount
    r1(i) = r1(i - 1) + 1
    If r1(i) > u Then r1(i) = l
    For j = 1 To NoStr
        r2(i) = r2(i) & "|" & Rnd & "|" & r1(i)
    Next j
Next i

For Each a In r2
    Range("B" & x) = a
    x = x + 1
Next a

    Columns("B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, Other:=True, OtherChar:="|"
    Columns("C:D").Sort Key1:=Range("C1"), Order1:=xlAscending
    Columns("E:F").Sort Key1:=Range("E1"), Order1:=xlAscending
    Columns("G:H").Sort Key1:=Range("G1"), Order1:=xlAscending
    Columns("I:J").Sort Key1:=Range("I1"), Order1:=xlAscending
    Columns("K:L").Sort Key1:=Range("K1"), Order1:=xlAscending
    Range("C:C,E:E,G:G,I:I,K:K").Delete Shift:=xlToLeft

End Sub

 

[Naxos2032]

Thanks heaps for that! It worked perfectly for outputting the right amount of numbers but it seems to still output numbers that repeat in the same set. Example, set 1 after a generation was:

1, 1, 5, 1, 9

Is it possible to have the output sets having no repeating numbers while still outputting and equal amount for the overall sets or is that a programming impossibility? Im scratching my head here thinking it might be.

Many thanks for your help so far too!