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 .
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
If one day you have more than 500 000 elements within a Dictionary just keep in mind to try a VBA Collection …​
 
Upvote 0
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.

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
Thank you so much Eric.It is very useful to me.?
 
Last edited:
Upvote 0
It is a controversial subject ...
See topic
Performance: Dictionary vs. Collection

M.
Some bad things within this link in particular when the author stated he needs two VBA Collections to retrieve the keys​
but in fact it can be easily achieved with a single collection as I have created a Dictionary like class module​
to convert any Dictionary Windows VBA procedure on Mac or for the Windows users with some OS restrictions according to their companies rules …​
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,188
Members
448,554
Latest member
Gleisner2

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
Back
Top