Thanks:  0
Likes:  0

# Thread: Yet another Lottery number macro needed

I have to generate random numbers (about 500 of them) that are 8 digits long but both the 5th and the 8th need to be the same. ie digit five will always be 8 and digit eight will always be a 1 while all the other numbers will change.

I am happy either have 500 rows or simply have a "click button" that will randomly generate the numbers each time in the same 8 columns.

[ This Message was edited by: alexb on 2002-05-02 07:05 ]

2. G'day,

any other special rules we should know? like are all 500 numbers expected to be different? If not, you could use something a bit more simple like:

=(Randbetween(0,9)&Randbetween(0,9)&Randbetween(0,9)&Randbetween(0,9)&8&Randbetween(0,9)&Randbetween(0,9)&1)+0

with a cell formatting of custom "0000000#"

Hope that helps,

Still need more help - I can't just type the formula in a cell and if i paste it into VBA then it won't know what cell to put the numbers in.

Sorry to be so lame.

4. Alexb,
There are many examples of lottery code on the net...
Type in "Lottery macro Excel VBA"
Tom

5. tis is east yo edit as you require, i credit my great pal Dave Hawley http://www.ozgrid.com for this one, i cant find my lotto numbers i designed. which was quite cool and very simple.

Sub RandomNumberGenerator()
'Creates a list of random numbers _
between 1 and 36 in range A1:F6
'www.ozgrid.com
Dim Rw As Integer, Col As Integer
'Clear the range ready for random numbers
Range("A1:B18").Clear
Randomize ' Initialize random-number generator.
For Col = 1 To 2 'Set the Column numbers
For Rw = 1 To 18 'Set the Row numbers
'
Cells(Rw, Col) = Int((36 * Rnd) + 1)
Do Until WorksheetFunction.CountIf _
(Range("A1:B18"), Cells(Rw, Col)) = 1
Cells(Rw, Col) = Int((36 * Rnd) + 1)
Loop

Next Rw
Next Col
End Sub

6. Try the following vba below. The goal is to create 500 unique numbers following your constraints:

Code:
```Option Explicit
Sub Ran()
Dim upr As Integer, lwr As Integer
Dim upr2 As Integer, lwr2 As Integer, cell As Range
Dim LastRow As Long, myrng As Range, c As Range
Dim SearchValue As String
upr = 9999 'upper1 integer limit
lwr = 1000 'lower1 integer limit
upr2 = 10 'upper1 integer limit
lwr2 = 99 'lower1 integer limit
Application.ScreenUpdating = False
For Each cell In [a1:a500]
Randomize
cell.Value = Int((upr - lwr + 1) * Rnd + lwr) & "8" _
& Int((upr2 - lwr2 + 1) * Rnd + lwr2) & "1"
test: 'For uniqueness that is
LastRow = cell.Row - 1
If LastRow = 0 Then GoTo 1
Set myrng = Range("a1:a" & LastRow)
Set c = Range("A1:A" & LastRow).Find(what:=cell.Value, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
[a65536].End(xlUp) = Int((upr - lwr + 1) * Rnd + lwr) & "8" _
& Int((upr2 - lwr2 + 1) * Rnd + lwr2) & "1"
GoTo test
End If
Set myrng = Nothing
Set c = Nothing
1:
Next cell
Application.ScreenUpdating = True
End Sub```
Put this in a dedicated normal module. Hope this helps.

_________________
Cheers, NateO

[ This Message was edited by: NateO on 2002-05-07 19:14 ]

## User Tag List

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•