Random Number

Sanjayaranj

New Member
Joined
May 7, 2021
Messages
8
Office Version
  1. 2010
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
Joined
May 7, 2021
Messages
8
Office Version
  1. 2010
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

Excel Can Read to You
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
Joined
Aug 18, 2015
Messages
11,107
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
Joined
May 7, 2021
Messages
8
Office Version
  1. 2010
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😊
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
11,107

ADVERTISEMENT

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
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
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
Joined
Aug 23, 2010
Messages
16,655
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

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
Windows 7 Home Premium
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
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
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
Joined
Aug 23, 2010
Messages
16,655
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
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 …​
 

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top