• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need help with VBA Code for generating lotto numbers from list column A

carloc

New Member
Good morning, i am an excel beginner and in my free time i made a random picking number lottery but the one that i have found here on the website is much more better.I would ask you a favor, can you make 6 number picking instead of 5? I tried to modify the code but with no success. I attach an image for giving the idea of it and the file i was working on.

The 6 numbers should be picked by those on the column A. Thank you in advance and i hope to hear you soon,

Regards

Carlo
 

Attachments

  • Copy CFL2.xlsm
    950.3 KB · Views: 5
  • Immagine.png
    Immagine.png
    35.7 KB · Views: 6
Drag K1 to L1 then from the 'Menu Ribbon' choose 'Developer' and turn-on 'Design Mode' then copy Textbox nr.5 and paste it beside. When done turn-off 'Design Mode'. If you don't see the Developer tab you need to enable it from the Options menu customizing the Ribbon by checking Developer in the Main tabs.
Now substitute the macros 'bClearAll' and 'bGenerate' with these updated ones:
Code:
'Clear All
Sub bClearAll()
    Dim i      As Integer
    For i = 1 To 6
        Picks.OLEObjects("TextBox" & i).Object.Value = ""
    Next i
    'Picks.OLEObjects("tSet").Object.Value = 1
    Picks.tSet.Value = 1
End Sub

'Generate
Sub bGenerate()
    Dim ws     As Worksheet, rStart As Range, rS As Range
    Dim i      As Long, ii As Integer, j As Long, k As Long
    Dim tf     As Boolean, a(1 To 6), b
    Dim r      As Range, rr

    Set ws = Picks
    Set r = Picks.Range("A1", Picks.Range("A1").End(xlDown))
    'Remove possible duplicate values
    rr = UniqueArrayByDict(r.Value)               'Base 0 array.
    'Title Cell for first random number set on Picks sheet
    Set rStart = ws.Range("G5")
    'Check if any preferred numbers were set.
    'All blank or all numbers means no preference.
    For i = 1 To 6
        a(i) = Val(Picks.OLEObjects("TextBox" & i).Object.Value)
        If a(i) = 0 Then
            j = j + 1
        Else
            k = k + 1
        End If
    Next i
    'Ok to generate all 5 numbers?
    If j = 6 Or k = 6 Then
        tf = True
    Else                                          'Add numbers that may not be in rr.
        For k = 0 To 5
            If a(k + 1) <> 0 Then
                ReDim Preserve rr(0 To UBound(rr) + 1)
                rr(UBound(rr)) = a(k + 1)
            End If
        Next k
    End If
    'Remove possible duplicate values that were added.
    rr = UniqueArrayByDict(rr)                    'Base 0 array.
    If Not IsNumeric(Picks.tSet.Value) Then Picks.tSet.Value = 1
    For i = 1 To Picks.tSet.Value
        'Next blank cell in Picks sheet for next set of numbers
        Set rS = ws.Cells(Rows.Count, rStart.Column).End(xlUp).Offset(1)
Generate:
        If rS.Row < 5 Then Set rS = ws.Cells(5, rS.Column)
        b = RndIntPick(1, UBound(rr) + 1, 6)      'Base 0 array.
        'Set elements in b to rr values.
        For k = 0 To 5
            b(k) = rr(b(k) - 1)                   'Random picks from col A in b now.
        Next k
        'Resort b
        b = ArrayListSort(b)
        If Not tf Then
            For ii = 1 To 5
                If a(ii) <> 0 And b(ii - 1) <> a(ii) Then GoTo Generate
            Next ii
        End If
        For ii = 0 To 5
            Picks.OLEObjects("TextBox" & ii + 1).Object.Value = Format(b(ii), "0#")
            rS.Offset(, ii).Value = b(ii)
        Next ii
    Next i
End Sub
 
Last edited:
Back
Top