Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

Thread: Yet another Lottery number macro needed

  1. #1
    New Member
    Join Date
    Mar 2002
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Southfield,MI USA
    Posts
    2,312
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  3. #3
    New Member
    Join Date
    Mar 2002
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.

  4. #4
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  5. #5
    Board Regular
    Join Date
    Feb 2002
    Posts
    3,184
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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



    Free Excel based Web Toolbar available here.

    Jack in the UK
    J & R Excel Solutions
    "making Excel work for you"

  6. #6
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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