VBA especial random numbers generator with option includes or exclude

motilulla · Jul 27, 2016

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

VBA give an input option for both 1^st 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 2^nd 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)
Input option how many sets require for example 5, 10, 15, or 20 random sets output them in B6:F15
If possible (not important) output numbers could be organized in ascending order smaller to higher will the better.

Example...

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

Exclude

2

7

12

22

27

32

38

40

42

45

47

3

Include

20

47

4

5

n1

n2

n3

n4

n5

6

Set 01

5

26

31

36

37

7

Set 02

13

16

19

21

35

8

Set 03

8

30

37

41

48

9

Set 04

10

17

18

19

41

10

Set 05

8

13

21

31

34

11

Set 06

14

16

23

36

37

12

Set 07

4

17

19

28

34

13

Set 08

10

25

46

48

49

14

Set 09

1

5

15

30

44

15

Set 10

11

23

24

30

48

16

Sheet1

Thanks In Advance
Using version 2000

Regards,
Moti

motilulla · Jul 27, 2016

B___P · Jul 27, 2016

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

Rick Rothstein · Jul 27, 2016

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...

A B C D E F G H I J K L M N
1
2 Exclude 2 7 12 22 27 32 38 40 42 45 47
3 Include 20 47
4
5 n1 n2 n3 n4 n5
6 Set 01 5 26 31 36 37
7 Set 02 13 16 19 21 35
8 Set 03 8 30 37 41 48
9 Set 04 10 17 18 19 41
10 Set 05 8 13 21 31 34
11 Set 06 14 16 23 36 37
12 Set 07 4 17 19 28 34
13 Set 08 10 25 46 48 49
14 Set 09 1 5 15 30 44
15 Set 10 11 23 24 30 48
16

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1

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?

B___P · Jul 27, 2016

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

motilulla · Jul 27, 2016

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

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

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

Exclude

2

3

Include

20

4

5

n1

n2

n3

n4

n5

6

Set 01

7

Set 02

8

Set 03

9

Set 04

10

Set 05

11

Set 06

12

Set 07

13

Set 08

14

Set 09

15

Set 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

motilulla · Jul 27, 2016

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?

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

B___P · Jul 27, 2016

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

motilulla · Jul 27, 2016

B___P said:
Amended and added feature, give it a try

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

B___P · Jul 27, 2016

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

VBA especial random numbers generator with option includes or exclude

motilulla

Well-known Member

Excel Facts

motilulla

Well-known Member

B___P

Active Member

Rick Rothstein

MrExcel MVP

B___P

Active Member

motilulla

Well-known Member

motilulla

Well-known Member

B___P

Active Member

motilulla

Well-known Member

B___P

Active Member

Similar threads

Forum statistics

Share this page

VBA especial random numbers generator with option includes or exclude

Well-known Member

Excel Facts

Well-known Member

Active Member

MrExcel MVP

Active Member

Well-known Member

Well-known Member

Active Member

Well-known Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock