VBA especial random numbers generator with option includes or exclude

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello

I am looking for a lottery 5/50 exclusive random number generators I search in the Mr.Excel forums and also in Internet but do not find it.

With following features…
I will make a list of numbers need to Excluded in row 2 or numbers to be Include in row 3


  1. VBA give an input option for both 1st input exclude so I can select the numbers to be excluded from the row2, if I do not want to exclude any skip this step, and 2nd input include may be 1,2 or max 3 numbers, if I do not want to include any skip this step, (so within set of 5 included number must be picked rest random numbers be added to make 5 in total)
  2. Input option how many sets require for example 5, 10, 15, or 20 random sets output them in B6:F15
  3. If possible (not important) output numbers could be organized in ascending order smaller to higher will the better.

Example...


Book1
ABCDEFGHIJKLMN
1
2Exclude27122227323840424547
3Include2047
4
5n1n2n3n4n5
6Set 01526313637
7Set 021316192135
8Set 03830374148
9Set 041017181941
10Set 05813213134
11Set 061416233637
12Set 07417192834
13Set 081025464849
14Set 0915153044
15Set 101123243048
16
Sheet1


Thanks In Advance
Using version 2000

Regards,
Moti
 
Sort by date Sort by votes
Hi Moti, here the macro you need.

Code: 
Sub randomoti()
Dim arraynumbers(1 To 50)
Reply = MsgBox("are there numbers to EXclude?", vbYesNo, "www")
If Reply = vbYes Then
    Set exrng = Range("b2", Cells(2, Range("b2").End(xlToRight).Column))
    exrng.Select
End If
 
Reply = MsgBox("are there numbers to INclude?", vbYesNo)
If Reply = vbYes Then
    Set inrng = Range("b3", Cells(3, Range("b3").End(xlToRight).Column))
    inrng.Select
    Ninrng = inrng.Columns.Count
Else
    Ninrng = 0
End If

sets = Application.InputBox(Prompt:="How many sets?", Type:=1)
If sets = False Then
    MsgBox ("macro ends")
    End
End If
Set outrng = Range("B6:f" & 6 + sets - 1)
Application.ScreenUpdating = False
Range(Cells(6, 2), Cells(Range("B6").End(xlDown).Row, 6)).ClearContents

'initialize numbers
For x = 1 To 50
    arraynumbers(x) = x 'Sheets("Foglio6").Cells(x, 11).Value
Next x
For x = 1 To exrng.Columns.Count
    arraynumbers(exrng.Columns(x).Value) = 0
Next x
For x = 1 To inrng.Columns.Count
    arraynumbers(inrng.Columns(x).Value) = 0
Next x
'end initialize numbers

For r = 1 To sets
    arraynum = arraynumbers
    If Ninrng Then
        For c = 1 To Ninrng
            Cells(5 + r, 1 + c).Value = inrng.Columns(c).Value
        Next c
    End If
    For c = 1 + Ninrng To 5
        Do Until Cells(5 + r, 1 + c).Value <> 0
            myrandom = Int(Rnd() * 25) + 1
            If arraynum(myrandom) <> 0 Then
                Cells(5 + r, 1 + c).Value = arraynum(myrandom)
                arraynum(myrandom) = 0
            End If
        Loop
    Next c
    
'sorting routine
    For i = 1 To 5 - 1
        For j = i + 1 To 5
            If Cells(5 + r, 1 + i).Value > Cells(5 + r, 1 + j).Value Then
                temp = Cells(5 + r, 1 + i).Value
                Cells(5 + r, 1 + i).Value = Cells(5 + r, 1 + j).Value
                Cells(5 + r, 1 + j).Value = temp
            End If
        Next j
    Next i
'end sorting route
Next r
Application.ScreenUpdating = True
MsgBox ("END")
End Sub

Hope this helps
 
Upvote 0
motilulla said:
With following features…
I will make a list of numbers need to Excluded in row 2 or numbers to be Include in row 3
Example...

ABCDEFGHIJKLMN

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]
[TD="align: center"]Exclude[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]7[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"]22[/TD]
[TD="align: center"]27[/TD]
[TD="align: center"]32[/TD]
[TD="align: center"]38[/TD]
[TD="align: center"]40[/TD]
[TD="align: center"]42[/TD]
[TD="align: center"]45[/TD]
[TD="align: center"]47[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="align: center"]Include[/TD]
[TD="align: center"]20[/TD]
[TD="align: center"]47[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: center"]n1[/TD]
[TD="align: center"]n2[/TD]
[TD="align: center"]n3[/TD]
[TD="align: center"]n4[/TD]
[TD="align: center"]n5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="align: center"]Set 01[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]26[/TD]
[TD="align: center"]31[/TD]
[TD="align: center"]36[/TD]
[TD="align: center"]37[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="align: center"]Set 02[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]16[/TD]
[TD="align: center"]19[/TD]
[TD="align: center"]21[/TD]
[TD="align: center"]35[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: center"]Set 03[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]30[/TD]
[TD="align: center"]37[/TD]
[TD="align: center"]41[/TD]
[TD="align: center"]48[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="align: center"]Set 04[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]17[/TD]
[TD="align: center"]18[/TD]
[TD="align: center"]19[/TD]
[TD="align: center"]41[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]10[/TD]
[TD="align: center"]Set 05[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]21[/TD]
[TD="align: center"]31[/TD]
[TD="align: center"]34[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]11[/TD]
[TD="align: center"]Set 06[/TD]
[TD="align: center"]14[/TD]
[TD="align: center"]16[/TD]
[TD="align: center"]23[/TD]
[TD="align: center"]36[/TD]
[TD="align: center"]37[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]12[/TD]
[TD="align: center"]Set 07[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]17[/TD]
[TD="align: center"]19[/TD]
[TD="align: center"]28[/TD]
[TD="align: center"]34[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]13[/TD]
[TD="align: center"]Set 08[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]25[/TD]
[TD="align: center"]46[/TD]
[TD="align: center"]48[/TD]
[TD="align: center"]49[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]14[/TD]
[TD="align: center"]Set 09[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]15[/TD]
[TD="align: center"]30[/TD]
[TD="align: center"]44[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]15[/TD]
[TD="align: center"]Set 10[/TD]
[TD="align: center"]11[/TD]
[TD="align: center"]23[/TD]
[TD="align: center"]24[/TD]
[TD="align: center"]30[/TD]
[TD="align: center"]48[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]16[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>
Sheet1​
Click to expand...
Can you explain the "Include" part of your request in more detail please. Your example shows two numbers (20 and 47) in the "Include" row, but none of the generated sets show either of those numbers... so exactly what does it mean to have included numbers?
 
Upvote 0
Hi moti, after edit time expired I discovered a typo in my macro. It limited numbers to 25...
Here the correct code

Code: 
Sub randomoti()
Dim arraynumbers(1 To 50)
Reply = MsgBox("are there numbers to EXclude?", vbYesNo, "www")
If Reply = vbYes Then
    Set exrng = Range("b2", Cells(2, Range("b2").End(xlToRight).Column))
    exrng.Select
End If
 
Reply = MsgBox("are there numbers to INclude?", vbYesNo)
If Reply = vbYes Then
    Set inrng = Range("b3", Cells(3, Range("b3").End(xlToRight).Column))
    inrng.Select
    Ninrng = inrng.Columns.Count
Else
    Ninrng = 0
End If

sets = Application.InputBox(Prompt:="How many sets?", Type:=1)
If sets = False Then
    MsgBox ("macro ends")
    End
End If
Application.ScreenUpdating = False
Range(Cells(6, 2), Cells(Range("B6").End(xlDown).Row, 6)).ClearContents

'initialize numbers
For x = 1 To 50
    arraynumbers(x) = x 'Sheets("Foglio6").Cells(x, 11).Value
Next x
For x = 1 To exrng.Columns.Count
    arraynumbers(exrng.Columns(x).Value) = 0
Next x
For x = 1 To inrng.Columns.Count
    arraynumbers(inrng.Columns(x).Value) = 0
Next x
'end initialize numbers

For r = 1 To sets
    arraynum = arraynumbers
    If Ninrng Then
        For c = 1 To Ninrng
            Cells(5 + r, 1 + c).Value = inrng.Columns(c).Value
        Next c
    End If
    For c = 1 + Ninrng To 5
        Do Until Cells(5 + r, 1 + c).Value <> 0
            myrandom = Int(Rnd() * 50) + 1
            If arraynum(myrandom) <> 0 Then
                Cells(5 + r, 1 + c).Value = arraynum(myrandom)
                arraynum(myrandom) = 0
            End If
        Loop
    Next c
    
'sorting routine
    For i = 1 To 5 - 1
        For j = i + 1 To 5
            If Cells(5 + r, 1 + i).Value > Cells(5 + r, 1 + j).Value Then
                temp = Cells(5 + r, 1 + i).Value
                Cells(5 + r, 1 + i).Value = Cells(5 + r, 1 + j).Value
                Cells(5 + r, 1 + j).Value = temp
            End If
        Next j
    Next i
'end sorting route
Next r
Application.ScreenUpdating = True
MsgBox ("END")
End Sub
 
Upvote 0
B___P said:
Hi moti, after edit time expired I discovered a typo in my macro. It limited numbers to 25...
Here the correct code
Click to expand...
Thank you so much. B___P, Sweet!! It is perfet as require

Scenario post#1 Response Yes
Are there numbers to EXclude? Response Yes
Are there numbers to INclude? Response Yes
How many sets? Response 10
Macro generate 10 set excluding & including number works 100 % perfect

Please could you check in the following situation it does not works

Scenario post#1 Response No (if response is no macro must create sets usiug all 50 numbers)
Are there numbers to EXclude? Response No
Are there numbers to INclude? Response No
How many sets? Response 10
Stop At the line highlighted in red
Code: 
 [COLOR=#FF0000]For x = 1 To exrng.Columns.Count[/COLOR]
    arraynumbers(exrng.Columns(x).Value) = 0
Next x

Using scenario below


Book1
ABCDEFGHIJKLMN
1
2Exclude2
3Include20
4
5n1n2n3n4n5
6Set 01
7Set 02
8Set 03
9Set 04
10Set 05
11Set 06
12Set 07
13Set 08
14Set 09
15Set 10
16
Trail


Response Yes…
Are there numbers to EXclude? Response Yes
Are there numbers to INclude? Response Yes
How many sets? Response 10
Stop At the line highlighted in red
Code: 
For x = 1 To exrng.Columns.Count
   [COLOR=#FF0000] arraynumbers(exrng.Columns(x).Value) = 0[/COLOR]
Next x

Response No…
Are there numbers to EXclude? Response No
Are there numbers to INclude? Response No
How many sets? Response 10
Stop At the line highlighted in red
Code: 
[COLOR=#FF0000]For x = 1 To exrng.Columns.Count[/COLOR]
    arraynumbers(exrng.Columns(x).Value) = 0
Next x

Regards,
Moti
 
Upvote 0
Rick Rothstein said:
Can you explain the "Include" part of your request in more detail please. Your example shows two numbers (20 and 47) in the "Include" row, but none of the generated sets show either of those numbers... so exactly what does it mean to have included numbers?
Click to expand...
Hello Rick Rothstein, thank you for your response

I also was rereading post#1, which is bit confusing in simple words I need 5/50 lottery random number generator, which can generate 10 sets at once VBA is run out of 1 to 50 numbers each set of 5 numbers

Include I mean-Now for example I want to add 1, 2, or max 3 my favourite numbers VBA give input option to enter favourite numbers for example my 2 favourites number are 15 & 42 so VBA generate 10 sets each set of 5 numbers and in all 10 set (my 2 favourite numbers 15 & 42 must be present) so example set1- 1-12-15-22-42, set2- 10-15-22-42-48 and so on…

Exclude I mean-Now for example I do not want following 8 numbers to be used example 2-4-19-32-34-36-41-50 so far 50-8 = random could be formed out of 42 numbers

Hope this helps

Regards,
Moti


 
Upvote 0
Amended and added feature, give it a try

Code: 
Sub RandomTickets()
Dim arraynumbers(1 To 50)
Reply = MsgBox("are there numbers to EXclude?", vbYesNo)
If Reply = vbYes Then
    Set exrng = Range("b2", Cells(2, Range("a2").End(xlToRight).Column))
    Nexrng = exrng.Columns.Count
Else
    Nexrng = 0
End If
 
Reply = MsgBox("are there numbers to INclude?", vbYesNo)
If Reply = vbYes Then
    Set inrng = Range("b3", Cells(3, Range("a3").End(xlToRight).Column))
    Ninrng = inrng.Columns.Count
    If Ninrng > 4 Then
        MsgBox ("Wrong Numbers to include")
        End
    End If
Else
    Ninrng = 0
End If

Reply = MsgBox("Free numbers only once?", vbYesNo, "NO REPETITIONS?")
If Reply = vbYes Then
    noRep = 1
    sets = Int((50 - Nexrng - Ninrng) / (5 - Ninrng))
Else
    noRep = 0
    sets = Application.InputBox(Prompt:="How many sets?", Type:=1)
    If sets = False Then
        MsgBox ("macro ends")
        End
    End If
End If

If sets < 1 Then
    MsgBox ("Bad constrains. Macro ends")
    End
End If


Application.ScreenUpdating = False
Range(Cells(6, 2), Cells(Range("B6").End(xlDown).Row, 6)).ClearContents

'initialize numbers
For x = 1 To 50
    arraynumbers(x) = x
Next x
For x = 1 To Nexrng
    arraynumbers(exrng.Columns(x).Value) = 0
Next x
For x = 1 To Ninrng
    arraynumbers(inrng.Columns(x).Value) = 0
Next x
'end initialize numbers

If noRep Then arraynum = arraynumbers 'outside loop for unique output

For r = 1 To sets
    If noRep = 0 Then arraynum = arraynumbers
    If Ninrng Then
        For c = 1 To Ninrng
            Cells(5 + r, 1 + c).Value = inrng.Columns(c).Value
        Next c
    End If
    For c = 1 + Ninrng To 5
        Do Until Cells(5 + r, 1 + c).Value <> 0
            myrandom = Int(Rnd() * 50) + 1
            If arraynum(myrandom) <> 0 Then
                Cells(5 + r, 1 + c).Value = arraynum(myrandom)
                arraynum(myrandom) = 0
            End If
        Loop
    Next c
    
'sorting routine
    For i = 1 To 5 - 1
        For j = i + 1 To 5
            If Cells(5 + r, 1 + i).Value > Cells(5 + r, 1 + j).Value Then
                temp = Cells(5 + r, 1 + i).Value
                Cells(5 + r, 1 + i).Value = Cells(5 + r, 1 + j).Value
                Cells(5 + r, 1 + j).Value = temp
            End If
        Next j
    Next i
'end sorting route
Next r
Application.ScreenUpdating = True
MsgBox ("END")
End Sub
 
Upvote 0
B___P said:
Amended and added feature, give it a try
Click to expand...
B___P, it seems to work it but can you check it generate random set if conditions applied some time 8 some time 9 some time 15 and I see without any conditions free number generate 10 with total = 1275 also could be free number generated any sets

Thank you

Regards,
Moti
 
Upvote 0
The added feature excludes numbers, uses in every ticket included numbers and if you decided for no repetitions (in free numbers) populates row with all tickets possible given those constrains. For ex. 8 numbers to exclude, 2 to include then possible sets without repetitions is (50-8-2)/(5-2)=13,3333 then the integer part 13
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Random Number Generator That Can Exclude Numbers
Replies
2
Views
809
FormulasOnly
F
M
  • Question Question
"Standard" lists of "random" numbers
Replies
5
Views
233
StephenCrump
S
N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
660
mumps
mumps
R
  • Question Question
Need help with random number generating
Replies
2
Views
601
royland27
R
J
  • Solved
Vba code to generate a list of numbers in random order
Replies
4
Views
799
Fluff
Fluff

Share this page

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