# Look for help with random number sets and equal distribution

#### Naxos2032

##### New Member
Hey everyone,

I’ve been working on some VBA for a week or two now and am still running into a few issues. I’m looking to make a random number generator that outputs sets based on pre-required input. IN ADDITION to that, I also want it to distribute the numbers output across the sets evenly, which I’m not sure can be done?

So far I’ve got the below which creates sets based on input with no repetitions per a set (which is what I need)

Code:
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
And here I’ve got the even distribution working fine across the total amount of output numbers but there can be multiple occurrences of the same number per a set EG 1, 1, 4, 7, 7.

Code:
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
So I’m looking for anything that could help me (code/suggestions/links) to combine the two macros to eventually output a number of sets (based on input) with no repeating numbers per a set, with an even distribution of numbers across the total sets.

So, for 5 numbers per a set between 1 and 10, there would be 50 x 1, 50 x 2, and so on but every set on every row wouldn’t have a number occur more than once. Don’t know if that explains it?

Any help greatly appreciated.

### Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Replies
2
Views
241
Replies
14
Views
530
Replies
2
Views
213
Replies
3
Views
225
Replies
3
Views
140

1,196,345
Messages
6,014,730
Members
441,842
Latest member
mattdale

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back