Random Number

[Sanjayaranj]

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]

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 :​

combinations generator

Hey, I am trying to find the different combinations that can be formed by choosing 11 out of 22 objects ( i.e. C(22,11) ). I have posted below the code I tried using. the problem is that this code give me all possible combinations whereas I only need different ways in which 11 objects can be...

www.mrexcel.com

 

[Marcelo Branco]

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]

​

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]

There are 614 valid combinations. Starting with Marcelo's layout:

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Numbers
2	1	3	4	7	9	10	11	14	15	18	19	21	24	25
3
4	Exclude			Results
5	1	4
6	1	11
7	1	14
8	4	7
9	4	14
10	4	25
11	15	18
12	15	19
13	21	25
Sheet14

This macro will enumerate them all:

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]

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]

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

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]

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
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Numbers
2	1	3	4	7	9	10	11	14	15	18	19	21	24	25
3	Size	6
4	Exclude			Results
5	1	4
6	1	11
7	1	14
8	4	7
9	4	14
10	4	25
11	15	18
12	15	19
13	21	25
Sheet14

Then here is the macro:

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.

 

[Sanjayaranj]

If only you have well elaborated your initial post in order there is nothing to guess as you never mentioned that !​

Thank you

 

[Marc L]

​

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]

Another improvement - a little bit faster macro

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.