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 .
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
It's not difficult to first generate all combinations - when the initial post is at least at the level of what any forum expects for ! -​
then the matching pairs combinations should be deleted.​
Combinations sample in this thread for starters :​
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Marcelo Branco

MrExcel MVP
Joined
Aug 23, 2010
Messages
16,655
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Marc

"It's not difficult to first generate all combinations"
Yes, that is easy
=COMBIN(14,6) --> 3003
But this requires a completely different approach - to generate all combinations and eliminate those that do not satisfy the exclusion list.

M.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
Yes Marcelo you are right as « generate random numbers with some conditions » does very not mean to calculate all the combinations !​
The reason why I was expecting answers before to post any procedure and according to the initial post this thread can be considered as solved …​
Hoping the OP in its next thread will at least do the necessary in the initial post.​
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
11,107
There are 614 valid combinations. Starting with Marcelo's layout:

Book1
ABCDEFGHIJKLMN
1Numbers
213479101114151819212425
3
4ExcludeResults
514
6111
7114
847
9414
10425
111518
121519
132125
Sheet14


This macro will enumerate them all:

VBA Code:
Public mycount As Long
Public outputr(1 To 614, 1 To 6)

Sub test1()
Dim nums As Variant, ex As Object, i As Long

    mycount = 0
    nums = Range("A2:N2").Value
    Set ex = CreateObject("Scripting.Dictionary")
    For i = 5 To 13
        ex.Add Cells(i, "A") & "/" & Cells(i, "B"), 1
        ex.Add Cells(i, "B") & "/" & Cells(i, "A"), 1
    Next i
    
    Call recur("", nums, ex, 0)
    
    Range("D5").Resize(614, 6).Value = outputr
End Sub

Sub recur(ByVal res As String, ByRef nums, ByRef ex, ByVal lvl As Long)
Dim i As Long, j As Long, k1 As String, k2 As String

    If lvl = 6 Then
        mycount = mycount + 1
        For i = 1 To 6
            outputr(mycount, i) = nums(1, Asc(Mid(res, i, 1)))
        Next i
        Exit Sub
    End If
    
    If lvl = 0 Then
        strt = 1
    Else
        strt = Asc(Right(res, 1)) + 1
    End If
    For i = strt To 14
        For j = 1 To Len(res)
            k1 = nums(1, Asc(Mid(res, j, 1))) & "/" & nums(1, i)
            k2 = nums(1, i) & "/" & nums(1, Asc(Mid(res, j, 1)))
            If ex.exists(k1) Or ex.exists(k2) Then GoTo exc:
        Next j
        Call recur(res & Chr(i), nums, ex, lvl + 1)
exc:
    Next i
    
End Sub

It's not a particularly elegant macro. It hardcodes several specific values, making it not easily maintainable, but it works for this instance.
 

Marcelo Branco

MrExcel MVP
Joined
Aug 23, 2010
Messages
16,655
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

I agree, I also found exactly 614 correct combinations.

My macro is also not elegant :( - it lists all 3003 possible combinations and, for each one, in a cell next to it, it puts "Incorrect" or "Correct".

Of course, it is possible to eliminate incorrect combinations after listing them. It would be enough to group the correct lines (Sort) and delete (Clear contents) the incorrect ones :)

Eric's macro looks better.

M.
 

Marcelo Branco

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

M.
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
11,107

ADVERTISEMENT

Well, gosh, Marcello, you guilted me into cleaning up my macro! ;)

I added one cell in B3 to show how many numbers to include in the combinations:

Book1
ABCDEFGHIJKLMN
1Numbers
213479101114151819212425
3Size6
4ExcludeResults
514
6111
7114
847
9414
10425
111518
121519
132125
Sheet14


Then here is the macro:

VBA Code:
Option Explicit

Sub GetCombos()
Dim nums As Variant, ex As Object, rslts As Object, i As Long, siz As Long

    nums = Range("A2:" & Cells(2, Columns.Count).End(xlToLeft).Address).Value
    siz = Range("B3").Value
    Set ex = CreateObject("Scripting.Dictionary")
    Set rslts = CreateObject("Scripting.Dictionary")
    For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row
        ex.Add Cells(i, "A") & "/" & Cells(i, "B"), 1
    Next i
   
    Call recur(1, "", nums, ex, 0, siz, rslts)
   
    Range("D5").Resize(rslts.Count).Value = WorksheetFunction.Transpose(rslts.keys)
    Range("D5").Resize(rslts.Count).TextToColumns Destination:=Range("D5"), Comma:=True
End Sub

Sub recur(ByVal strt As Long, res As String, ByRef nums, ByRef ex, ByVal lvl As Long, siz As Long, ByRef rslts As Object)
Dim i As Long, MyFlag As Boolean, x As Variant
   
    If lvl = siz Then
        rslts.Add res, 1
        Exit Sub
    End If
   
    For i = strt To UBound(nums, 2)
        MyFlag = True
        For Each x In Split(res, ",")
            If ex.exists(x & "/" & nums(1, i)) Then
                MyFlag = False
                Exit For
            End If
        Next x
        If MyFlag Then Call recur(i + 1, res & nums(1, i) & ",", nums, ex, lvl + 1, siz, rslts)
    Next i
   
End Sub

The number of numbers in A2:N2 is variable, just enter as many as needed. The number of exclusions is variable, just add as many rows as needed. The numbers in row 2 should be sorted. The exclusions in columns A:B should have the lower number first.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,142
Office Version
  1. 2010
Platform
  1. Windows
As it could be done without any Dictionary so I'm surprised to see Eric you need two copies …​
Transposing here is not a concern but for some large combinations # like in post #11 link it's a no way …​
 

Marcelo Branco

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

Forum statistics

Threads
1,136,447
Messages
5,675,903
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