Yet another Lottery number macro needed

[alexb]

I need your help.
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 ]

[Asala42]

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,
Adam

[alexb]

Adam,

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.

[Tom Schreiner]

Alexb,
There are many examples of lottery code on the net...
Type in http://www.google.com
Type in "Lottery macro Excel VBA"
Search till your hearts content...
Tom

[Jack in the UK]

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
'Written by OzGrid Business Applications
'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

[NateO]

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

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 ]