# Random Number

#### Sanjayaranj

##### New Member
Hi Everybody ,
I need a help .
How to generate random numbers with some conditions.

Conditions
1. using these numbers.
1 3 4 7 9 10 11 14 15 18 19 21 24 25

2.I don’t need this pairs in a row
1 4
1 11
1 14
4 7
4 14
4 25
15 18
15 19
21 25

3. I need six numbers in a row

Examples

1 5 7 10 18 19 Correct
1 3 4 21 24 25 Incorrect
4 5 7 15 18 19 Incorrect
5 9 14 19 24 25 Correct

Any formulla? Or VBA code for this type .

#### Sanjayaranj

##### New Member
I improved my macro, it lists only the correct sets in columns D:I (beginning in D5:I5)
It uses the layout above: Numbers in A2:N2; Exclusion list in A5:B13

VBA Code:
``````Sub aTestV2()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim lLin As Long, lResult(1 To 6) As Long
Dim rData As Range, rExclusion As Range

Set rData = Range("A2:N2")
Set rExclusion = Range("A5:B13")
lLin = 4
For i = 1 To 9
For j = i + 1 To 10
For k = j + 1 To 11
For l = k + 1 To 12
For m = l + 1 To 13
For n = m + 1 To 14
lResult(1) = Application.Index(rData, i)
lResult(2) = Application.Index(rData, j)
lResult(3) = Application.Index(rData, k)
lResult(4) = Application.Index(rData, l)
lResult(5) = Application.Index(rData, m)
lResult(6) = Application.Index(rData, n)
If CheckExclusion(lResult, rExclusion) = False Then
lLin = lLin + 1
Range("D" & lLin).Resize(1, 6) = lResult
End If
Next n
Next m
Next l
Next k
Next j
Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
Dim rCell As Range

For Each rCell In rExclusion
If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
CheckExclusion = True
Exit For
End If
End If
Next rCell
End Function[
[/QUOTE]
Sanjayaranj,

If you need to generate all the possibilities, this makes the code much more complex - I don't know how to calculate how many different sets would be possible (???)

I'm afraid I don't know how to do this.

M.
[/QUOTE]
Thank you Marcelo.``````

Another improvement - a little bit faster macro

VBA Code:
``````Sub aTestV3()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim lLin As Long, lResult(1 To 6) As Long
Dim rData As Range, rExclusion As Range

Set rData = Range("A2:N2")
Set rExclusion = Range("A5:B13")
lLin = 4
For i = 1 To 9
lResult(1) = Application.Index(rData, i)
For j = i + 1 To 10
lResult(2) = Application.Index(rData, j)
For k = j + 1 To 11
lResult(3) = Application.Index(rData, k)
For l = k + 1 To 12
lResult(4) = Application.Index(rData, l)
For m = l + 1 To 13
lResult(5) = Application.Index(rData, m)
For n = m + 1 To 14
lResult(6) = Application.Index(rData, n)
If CheckExclusion(lResult, rExclusion) = False Then
lLin = lLin + 1
Range("D" & lLin).Resize(1, 6) = lResult
End If
Next n
Next m
Next l
Next k
Next j
Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
Dim rCell As Range

For Each rCell In rExclusion
If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
CheckExclusion = True
Exit For
End If
End If
Next rCell
End Function``````

M.
Another improvement - a little bit faster macro

VBA Code:
``````Sub aTestV3()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim lLin As Long, lResult(1 To 6) As Long
Dim rData As Range, rExclusion As Range

Set rData = Range("A2:N2")
Set rExclusion = Range("A5:B13")
lLin = 4
For i = 1 To 9
lResult(1) = Application.Index(rData, i)
For j = i + 1 To 10
lResult(2) = Application.Index(rData, j)
For k = j + 1 To 11
lResult(3) = Application.Index(rData, k)
For l = k + 1 To 12
lResult(4) = Application.Index(rData, l)
For m = l + 1 To 13
lResult(5) = Application.Index(rData, m)
For n = m + 1 To 14
lResult(6) = Application.Index(rData, n)
If CheckExclusion(lResult, rExclusion) = False Then
lLin = lLin + 1
Range("D" & lLin).Resize(1, 6) = lResult
End If
Next n
Next m
Next l
Next k
Next j
Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
Dim rCell As Range

For Each rCell In rExclusion
If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
CheckExclusion = True
Exit For
End If
End If
Next rCell
End Function``````

M.
I know you spent a lot of time picking out the perfect code.thanks genius

### Excel Facts

Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

#### Eric W

##### MrExcel MVP
As it could be done without any Dictionary so I'm surprised to see Eric you need two copies …
I didn't necessarily "need" two dictionaries. A dictionary is a data structure that seemed appropriate for parts of my design. I could have come up with another way if I'd had to. I looked at your macro from the link you posted. True, you didn't use dictionaries, but you also didn't have to worry about the excluded combinations. That would have required some kind of a redesign on your part.

Transposing here is not a concern but for some large combinations # like in post #11 link it's a no way …
I'm aware of the size limitations of TRANSPOSE. As you noted, that was not a consideration for this request. There are other methods that work which I have used when needed. I've written macros that generate combinations that span multiple sheets because the number of results exceeded the number of rows/columns on a single sheet. But you don't get out the jackhammer first, when all you need is a pushpin.

@Sanjayaranj , I'm glad we could help!

#### Sanjayaranj

##### New Member
I improved my macro, it lists only the correct sets in columns D:I (beginning in D5:I5)
It uses the layout above: Numbers in A2:N2; Exclusion list in A5:B13

VBA Code:
``````Sub aTestV2()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim lLin As Long, lResult(1 To 6) As Long
Dim rData As Range, rExclusion As Range

Set rData = Range("A2:N2")
Set rExclusion = Range("A5:B13")
lLin = 4
For i = 1 To 9
For j = i + 1 To 10
For k = j + 1 To 11
For l = k + 1 To 12
For m = l + 1 To 13
For n = m + 1 To 14
lResult(1) = Application.Index(rData, i)
lResult(2) = Application.Index(rData, j)
lResult(3) = Application.Index(rData, k)
lResult(4) = Application.Index(rData, l)
lResult(5) = Application.Index(rData, m)
lResult(6) = Application.Index(rData, n)
If CheckExclusion(lResult, rExclusion) = False Then
lLin = lLin + 1
Range("D" & lLin).Resize(1, 6) = lResult
End If
Next n
Next m
Next l
Next k
Next j
Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
Dim rCell As Range

For Each rCell In rExclusion
If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
CheckExclusion = True
Exit For
End If
End If
Next rCell
End Function[
[/QUOTE]
Sanjayaranj,

If you need to generate all the possibilities, this makes the code much more complex - I don't know how to calculate how many different sets would be possible (???)

I'm afraid I don't know how to do this.

M.
[/QUOTE]
Thank you Marcelo.``````

Sanjayaranj,

If you need to generate all the possibilities, this makes the code much more complex - I don't know how to calculate how many different sets would be possible (???)

I'm afraid I don't know how to do this.

M.
Thank you
I didn't necessarily "need" two dictionaries. A dictionary is a data structure that seemed appropriate for parts of my design. I could have come up with another way if I'd had to. I looked at your macro from the link you posted. True, you didn't use dictionaries, but you also didn't have to worry about the excluded combinations. That would have required some kind of a redesign on your part.

I'm aware of the size limitations of TRANSPOSE. As you noted, that was not a consideration for this request. There are other methods that work which I have used when needed. I've written macros that generate combinations that span multiple sheets because the number of results exceeded the number of rows/columns on a single sheet. But you don't get out the jackhammer first, when all you need is a pushpin.

@Sanjayaranj , I'm glad we could help!
Thank you for your help Eric

#### Marc L

##### Well-known Member
That would have required some kind of a redesign on your part.
Just two additional arrays for pairs …​

#### Eric W

##### MrExcel MVP

Just two additional arrays for pairs …​
And I don't believe you could use the COMBIN function to set the size of your output array, unless you're happy with many empty rows.

#### Marc L

##### Well-known Member
As it's very not a concern according to Excel / VBA basics ! (If you have well read my procedure using Resize statement …)
Marcelo stated for speed concern but for such few combinations the result should be near to instant in less than 0.3 second, on your side ?​

#### Marcelo Branco

##### MrExcel MVP

Marc

"Marcelo stated for speed concern but for such few combinations the result should be near to instant in less than 0.3 second, on your side ?"

An old machine, but a good one:
Dell iCore5 16GB RAM
Excel 2010 32 bits

aTestV2 0.98 seconds
aTestV3 0.80 seconds

Not a significant difference, but always important to improve the code, isn't it?

M.

#### Marc L

##### Well-known Member
Pretty good …​
You can divide by 2 maybe 3 just storing the result in an array in order to write it at once to the worksheet rather than cell by cell like in my link …​
(Less than 0.3 s on an old i3 laptop)

#### Marcelo Branco

##### MrExcel MVP
Yes, i thought about it but as my code's performance was, say, "decent", I went to look at other threads

M.

#### Marc L

##### Well-known Member
In fact I asked Eric about performance as recently on another forum the dictionary way was more than 3 times slower than a classic array way …​
Here with such few combinations it's not a concern.​
A trick with big huge large data >400k or 500k : using a VBA Collection is faster than with a Dictionary …​

Replies
1
Views
47
Replies
7
Views
239
Replies
1
Views
51
Replies
1
Views
67
Replies
3
Views
65

1,136,444
Messages
5,675,895
Members
419,591
Latest member
mersanko

### 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