Combination of 5 numbers from a range of cells, contains selected numbers up to 24 (1-47 random numbers) without repeats

K

kelstnmate

New Member
Joined
May 23, 2022
Messages
5
Office Version
  1. 2016
  2. 2013
  3. 2011
Platform
  1. Windows
Hi there,

Trying to make a table format for lottery "see attachment", where Column A is the numbers that are selected from 1-47 (but only choosing 24 numbers), where in column B thru G are generated all the possible combinations without repeats

I've seen other post and really interested how others were able to do excel to generate numbers with all possible combination without repeats
 

Attachments

  • Lotterytable.png
    Lotterytable.png
    113.4 KB · Views: 73

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Not clear for me:
Does it require ?:
- Genarate random list of unique numbers from 1-47 in A2:A25 (increasing order?)
- B2:F2: 5- unique number combination, for instant: 1 -5 -15 -25-40 (increasing order?)
similar to B3:F3,..., B25:F25

So, what data in column I to column K for?
 
Upvote 0
HI bebo021999

Thanks for the reply, sorry for not being thoroughly not sure how to explain it...

Yes A2:A25 is random numbers from that are selected from 1-47
Yes B2:F2 are the combinations

sorry for column I and K ignore, i was trying out the =combin() and how it works, forgot to delete it
 
Upvote 0
bebo021999 said:
Is column A required inscreasing order or could be any order?
Click to expand...
any order will do, as long as I type the numbers needed in A2:A5 it will automatically generate all the possible combinations without repeats
 
Upvote 0
as long as I type the numbers needed in A2:A5
Click to expand...
Do you mean A2:A25?
And A2:A25 is manual input?
I am thinking about a button, click it, then A2:A25 and B2:F25 will be generated automatically.
Does it meet?
 
Upvote 0
bebo021999 said:
Do you mean A2:A25?
And A2:A25 is manual input?
I am thinking about a button, click it, then A2:A25 and B2:F25 will be generated automatically.
Does it meet?
Click to expand...
Yes A2:A25
Yes it will be manually inputted
no need for the button, once inputting it, it will start to generates numbers
 
Upvote 0
this is an old macro, i once made for <=26 options (that's why I used letters A-Z), but if that number is greater then the only disadvantage is the string in column B is wrong. You need to know that the possible combinations are great (42.504)
combinaties
VBA Code: 
Global ptr As Long, icomb As Long, iLoop
Public MyResult, a(), arr3(), Arr_Exclusives, Aux(), MyChoices, iPlayers, WB150 As Worksheet, TB As Shape, bTekstbox, bUF1

Sub NewData()
     With Range("A2:A25")
          .Value = Range("N1:N47").Value
          .Sort .Range("A1"), Header:=xlNo
     End With
End Sub

Sub All_Combinations()
    t = Timer
     MyChoices = Range("A2:A25")
     MyCombinations_L 24, 5
     ReDim Preserve arr3(1 To UBound(arr3), 1 To 6)
     For i = 1 To UBound(arr3)
          For j = 1 To Len(arr3(i, 1))
               arr3(i, 1 + j) = MyChoices(Asc(Mid(arr3(i, 1), j, 1)) - 64, 1)
          Next
     Next
     Range("B2").Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3
     MsgBox Timer - t
End Sub




Sub MyCombinations_L(Aantal, gekozen)
     Dim L(), Arr(), Arr2(), iCombinations As Long, Last(), Actual()

     x = Evaluate("=char(row(65:" & 65 + Aantal - 1 & "))")
     L = Application.Transpose(x)
     t = Timer
     iCombinations = WorksheetFunction.Combin(Aantal, gekozen)  'aantal combinaties

     ReDim Actual(1 To gekozen)                                 'voorbereiden array

     ReDim Arr2(iCombinations - 1)                              'voorbereiden 2e array, igv. je de waarden wil zien
     ReDim arr3(1 To iCombinations, 1 To 1)

     For r = 1 To iCombinations                                 'alle combinaties doorlopen
          If r = 1 Then                                         '1e keer = alles op 1,2,3, .... zetten
               For k = 1 To gekozen: Actual(k) = k: Next
          Else
               vorig = Actual
               Actual(gekozen) = vorig(gekozen) + 1

               If Actual(gekozen) > Aantal Then                 'laatste voorbij target !
                    For k = gekozen - 1 To 1 Step -1            'voorgaande kolommen aflopen
                         If Actual(k) < Aantal - (gekozen - k) Then     'tot aan die kolom die nog 1 mag opgehoogd worden
                              Actual(k) = Actual(k) + 1         'die kolom 1 ophogen
                              For k1 = k + 1 To gekozen         'alle volgende kolommen
                                   Actual(k1) = Actual(k1 - 1) + 1     'gelijk aan de vorige kolom +1
                              Next
                              Exit For                          'wip uit de loop
                         End If
                    Next
               End If
          End If
          For k = 1 To gekozen: Arr2(r - 1) = Arr2(r - 1) & L(Actual(k)): Next     'vul de 2e array met de echte waarden
          If VarType(Arr_Exclusives) <> 0 Then
               For Each el In Arr_Exclusives
                    s1 = Replace(Replace(Arr2(r - 1), Mid(el, 1, 1), "", , , vbTextCompare), Mid(el, 2, 1), "", , , vbTextCompare)
                    If -Len(s1) + Len(Arr2(r - 1)) >= 2 Then Arr2(r - 1) = "~": Exit For
               Next
          End If
     Next
     fl = Filter(Arr2, "~", 0, vbTextCompare)
     MyResult = fl
     If UBound(fl) < 65530 Then
          arr3 = Application.Transpose(fl)
     Else
          ReDim arr3(1 To UBound(fl) + 1, 1 To 1)
          For i = 0 To UBound(fl): arr3(i + 1, 1) = fl(i): Next
     End If

     'MsgBox Timer - t
     'r1 = 50000
     'MsgBox r1 & " " & arr3(r1, 1) & "   " & MyResult(r1 - 1) & vbLf & 10 & " " & arr3(10, 1) & "   " & MyResult(9)


End Sub
 
Upvote 0
Solution
BSALV said:
this is an old macro, i once made for <=26 options (that's why I used letters A-Z), but if that number is greater then the only disadvantage is the string in column B is wrong. You need to know that the possible combinations are great (42.504)
combinaties
VBA Code: 
Global ptr As Long, icomb As Long, iLoop
Public MyResult, a(), arr3(), Arr_Exclusives, Aux(), MyChoices, iPlayers, WB150 As Worksheet, TB As Shape, bTekstbox, bUF1

Sub NewData()
     With Range("A2:A25")
          .Value = Range("N1:N47").Value
          .Sort .Range("A1"), Header:=xlNo
     End With
End Sub

Sub All_Combinations()
    t = Timer
     MyChoices = Range("A2:A25")
     MyCombinations_L 24, 5
     ReDim Preserve arr3(1 To UBound(arr3), 1 To 6)
     For i = 1 To UBound(arr3)
          For j = 1 To Len(arr3(i, 1))
               arr3(i, 1 + j) = MyChoices(Asc(Mid(arr3(i, 1), j, 1)) - 64, 1)
          Next
     Next
     Range("B2").Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3
     MsgBox Timer - t
End Sub




Sub MyCombinations_L(Aantal, gekozen)
     Dim L(), Arr(), Arr2(), iCombinations As Long, Last(), Actual()

     x = Evaluate("=char(row(65:" & 65 + Aantal - 1 & "))")
     L = Application.Transpose(x)
     t = Timer
     iCombinations = WorksheetFunction.Combin(Aantal, gekozen)  'aantal combinaties

     ReDim Actual(1 To gekozen)                                 'voorbereiden array

     ReDim Arr2(iCombinations - 1)                              'voorbereiden 2e array, igv. je de waarden wil zien
     ReDim arr3(1 To iCombinations, 1 To 1)

     For r = 1 To iCombinations                                 'alle combinaties doorlopen
          If r = 1 Then                                         '1e keer = alles op 1,2,3, .... zetten
               For k = 1 To gekozen: Actual(k) = k: Next
          Else
               vorig = Actual
               Actual(gekozen) = vorig(gekozen) + 1

               If Actual(gekozen) > Aantal Then                 'laatste voorbij target !
                    For k = gekozen - 1 To 1 Step -1            'voorgaande kolommen aflopen
                         If Actual(k) < Aantal - (gekozen - k) Then     'tot aan die kolom die nog 1 mag opgehoogd worden
                              Actual(k) = Actual(k) + 1         'die kolom 1 ophogen
                              For k1 = k + 1 To gekozen         'alle volgende kolommen
                                   Actual(k1) = Actual(k1 - 1) + 1     'gelijk aan de vorige kolom +1
                              Next
                              Exit For                          'wip uit de loop
                         End If
                    Next
               End If
          End If
          For k = 1 To gekozen: Arr2(r - 1) = Arr2(r - 1) & L(Actual(k)): Next     'vul de 2e array met de echte waarden
          If VarType(Arr_Exclusives) <> 0 Then
               For Each el In Arr_Exclusives
                    s1 = Replace(Replace(Arr2(r - 1), Mid(el, 1, 1), "", , , vbTextCompare), Mid(el, 2, 1), "", , , vbTextCompare)
                    If -Len(s1) + Len(Arr2(r - 1)) >= 2 Then Arr2(r - 1) = "~": Exit For
               Next
          End If
     Next
     fl = Filter(Arr2, "~", 0, vbTextCompare)
     MyResult = fl
     If UBound(fl) < 65530 Then
          arr3 = Application.Transpose(fl)
     Else
          ReDim arr3(1 To UBound(fl) + 1, 1 To 1)
          For i = 0 To UBound(fl): arr3(i + 1, 1) = fl(i): Next
     End If

     'MsgBox Timer - t
     'r1 = 50000
     'MsgBox r1 & " " & arr3(r1, 1) & "   " & MyResult(r1 - 1) & vbLf & 10 & " " & arr3(10, 1) & "   " & MyResult(9)


End Sub
Click to expand...
Fantastic it works great, thank you so much and thank you for your time
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Need help modify to pick any first number of my choice
Replies
6
Views
600
motilulla
M
serge
  • Question Question
#N/A cell skip.
Replies
3
Views
268
Peter_SSs
Peter_SSs
T
  • Solved
Weighted lottery help?
2
Replies
14
Views
4K
bebo021999
B
E
  • Solved
Performance issue using a combination of dropdowns & lookups
Replies
9
Views
616
Akuini
Akuini
K0st4din
  • Solved
Macros Serial number generation with repeatability comparison base
2 3
Replies
20
Views
822
StephenCrump
S

Forum statistics

Threads
1,223,897
Messages
6,175,271
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top