• 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.

FAO Narayank991

G

guitarman

Member
Hi Narayan

Its me again. My friend who runs a Lottery Syndicate asked me it I could give him a formula or a macro to give him all the possible combinations of the numbers from 1-49 which as you are aware runs into millions (13983816 to be precise) what he is going to do with it I have no idea but it will be on his computer not mine so I am not bothered.Anyway I have made this macro but I have gone wrong somewhere when I ask it to give me the numbers in the combo say sixty(60) it just gives all the combinations that add up to 60 i.e 1,2,3,4,5,45. If I ask it for 13983816 it just says no combinations. So I wondered wether you could run your expert eye over it to see were I have gone wrong.

[pre]
Code: 
Sub Combos()
'  Find all the combinations of six integer numbers, each in the range 1..49,
'  that sum to the value of a desired total. A combination may not have two
'  numbers that are the same. Results are written to columns A..F of the
'  active worksheet.
Dim Total   As Integer
Dim N1      As Integer
Dim N2      As Integer, Sum2     As Integer
Dim N3      As Integer, Sum3     As Integer
Dim N4      As Integer, Sum4     As Integer
Dim N5      As Integer, Sum5     As Integer
Dim N6      As Integer
Dim iRow    As Long

Total = CInt(InputBox("Enter desired total", "Combos", 22))
If Total = 0 Then Exit Sub

iRow = 0
For N6 = (Total + 15)  6 To 49
For N5 = 5 To N6 - 1
Sum5 = N5 + N6
For N4 = 4 To N5 - 1
Sum4 = Sum5 + N4
For N3 = 3 To N4 - 1
Sum3 = Sum4 + N3
For N2 = 2 To N3 - 1
Sum2 = Sum3 + N2
N1 = Total - Sum2
If N1 < 1 Then Exit For
If N1 < N2 Then
iRow = iRow + 1
Cells(iRow, 1) = N1
Cells(iRow, 2) = N2
Cells(iRow, 3) = N3
Cells(iRow, 4) = N4
Cells(iRow, 5) = N5
Cells(iRow, 6) = N6
End If
Next N2
Next N3
Next N4
Next N5
Next N6

MsgBox iRow & " combinations found.", vbInformation, "Combos"

End Sub
[/pre]
Many Thanks

Mike
 
Hi Mike ,


I am sorry but there seems to be some misunderstanding here ; the comments at the beginning of the macro are :



Find all the combinations of six integer numbers, each in the range 1..49,

that sum to the value of a desired total. A combination may not have two

numbers that are the same. Results are written to columns A..F of the

active worksheet.




So when you give an input of 60 , the macro will list out all the combinations that add up to 60 ; clearly , if you give an input of 13,983,816 , it will not be able to find any combination of 6 numbers which will add up to 13,983,816.


Narayan
 
Hi Narayan

Yes I have messed it up somehow I probably should not have put that I wanted to tell it to give me all combinations of 1-49. So do I put it like ("combos",1-49) will that give me them.

Mike
 
Hi Mike ,


Sorry , but extending this macro to 49 numbers is not so easy , since you will need 49 For ... Next Loops !


I think what your friend wants is not just a combination of all 49 numbers ; after all in any lottery , what is needed is a combination of 5 or 6 numbers , each of which may range from 1 through 99 ; e.g. one winning combination may be the 6 numbers 13 , 72 , 56 , 23 , 44 , 91.


In generating these combinations , I don't think any sum of the 6 numbers is involved ; can you confirm ?


Narayan
 
Hi Narayan

I have just been talking to him. Yes you are right he does not want the sum of 6 numbers he wants all the possible combinations of 1 to 49,in 6 number selections i.e 1,2,3,4,5,6,

1,2,3,4,5,7 1,2,3,4,5,8 etc,etc.Until you end up with 44,45,46,47,48,49. But if it cannot be done don't worry I will tell him it will take to much time.

Mike
 
If my statistics class serves me right, having 49 possible numbers, 6 locations, and assuming no repeats, total combinations is:

49*48*47*46*45*44

which is just north of 10 billion.

Even with Office 2007+, that's going to take a lot of cells to write down. =O
 
Unique combinations could be calculated as:

=COMBIN(49,6)


which comes to 13983816


You can probably generate a list

http://www.mathsisfun.com/combinatorics/combinations-permutations-calculator.html
 
Good day Luke M


just of 10 Billion combinations !!....not good odds for winning...better odds if I were to rob a bank :)
 
A formula based approach, but this seems to work:

http://www.ozgrid.com/forum/showthread.php?t=160998
 
Hi Luke

I have told my friend it will take to long to do and the space taken on his computer will be horrendous 13983816 cells and it will take him weeks to sift through them. But he has some theory that there is a pattern of how the numbers come out which I replied there are far cleverer people than you who would have thought of this years ago especially the computer wizards like you guys. But he said he will he will try to do it of which I replied Best Of Luck.

Mike
 
Hi Mike ,


Try the following code :

[pre]
Code: 
Sub Combos()
'  Find all the permutations of six integer numbers, each in the range 1..49.
'  A permutation may not have two numbers that are the same.
'  Results are written to columns A..F of the active worksheet.
Const MAXVAL = 11
Dim N1      As Integer
Dim N2      As Integer
Dim N3      As Integer
Dim N4      As Integer
Dim N5      As Integer
Dim N6      As Integer
Dim iRow    As Long

iRow = 0
Application.ScreenUpdating = False
For N6 = 1 To MAXVAL
For N5 = 1 To MAXVAL
For N4 = 1 To MAXVAL
For N3 = 1 To MAXVAL
For N2 = 1 To MAXVAL
For N1 = 1 To MAXVAL
If ((N1 <> N2) And (N1 <> N3) And (N1 <> N4) And (N1 <> N5) And (N1 <> N6) And (N2 <> N3) _
And (N2 <> N4) And (N2 <> N5) And (N2 <> N6) _
And (N3 <> N4) And (N3 <> N5) And (N3 <> N6) _
And (N4 <> N5) And (N4 <> N6) _
And (N5 <> N6)) Then
iRow = iRow + 1
Cells(iRow, 1) = N1
Cells(iRow, 2) = N2
Cells(iRow, 3) = N3
Cells(iRow, 4) = N4
Cells(iRow, 5) = N5
Cells(iRow, 6) = N6
End If
Next N1
Next N2
Next N3
Next N4
Next N5
Next N6
Application.ScreenUpdating = True
MsgBox iRow & " permutations found.", vbInformation, "Combos"
End Sub
[/pre]
I have kept MAXVAL as 11 , so that all the individual numbers can go from 1 through 11 ; if you change the 11 to 49 , then all the individual numbers can go from 1 through 49.


For MAXVAL = 11 , the number of permutations possible is 332,640 which is 11 x 10 x 9 x 8 x 7 x 6 , since we are assuming that we cannot have 2 digits with the same value.


For MAXVAL = 49 , the number of permutations possible will be 10,068,347,520 !


If we consider combinations , which means the order does not matter , then the number will be considerably less ; even with MAXVAL = 49 , the number of combinations will only be 13,983,816.


However , the programming to list combinations will be slightly more complicated , since we need to ignore the different permutations once the combination has been printed.


Narayan
 
Hi Narayan

Thanks for that I will give it to him and he can see how he gets on. I have wasted enough time with this (And you more so.) I have told him it is to complicated and takes up an awful lot of time and a horrendous amount of cells but that is upto him. Once again many thanks for your time and trouble and have a great day and of course a brilliant life.

Many Thanks

Mike
 
Hi Mike ,


Not at all ; the Internet has enough programs to just list out all the combinations ; I have come across one which creates a text file with all the combinations ; this would be ideal for your friend , since it will overcome Excel's limit on rows.


This is a wonderfully elegant program , available here :


http://www.vbaexpress.com/forum/showthread.php?t=36194


I am reproducing it here :

[pre]
Code: 
Option Explicit

Sub exa()
'   Include a reference to MICROSOFT SCRIPTING RUNTIME
Const NUMBER_OF_CHOICES = 6
Dim FSO As FileSystemObject
Dim FIL As TextStream

Dim a, b
Dim n As Long

Set FSO = New FileSystemObject
Set FIL = FSO.CreateTextFile(ThisWorkbook.Path & "Test.txt")

a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49)

b = createCombinations(a, NUMBER_OF_CHOICES, ",")
For n = LBound(b) To UBound(b)
FIL.WriteLine b(n)
Next

FIL.Close
End Sub

Public Function createCombinations(Arr, NbrItems As Integer, Delim As String)
createCombinations = createSubset(Arr, NbrItems, Delim)
End Function

Public Function createSubset(Arr, NbrItems As Integer, Delim As String)
Dim Rslt
ReDim Rslt(0)

aSubset Arr, LBound(Arr), NbrItems, Delim, "", Rslt
ReDim Preserve Rslt(UBound(Rslt) - 1)
'Debug.Assert NbrElements(Rslt) = _
Application.WorksheetFunction.Combin(NbrElements(Arr), NbrItems)
createSubset = Rslt
End Function

Private Sub aSubset(Arr, CurrIdx, NbrItems, ByVal Delim As String, _
ByVal PreString As String, ByRef Rslt)
Dim i As Integer
If NbrItems = 0 Then
If PreString = "" Then Rslt(UBound(Rslt)) = PreString _
Else Rslt(UBound(Rslt)) = Left(PreString, Len(PreString) - Len(Delim))
ReDim Preserve Rslt(UBound(Rslt) + 1)
Else
For i = CurrIdx To NbrElements(Arr) - NbrItems + LBound(Arr)
aSubset Arr, i + 1, NbrItems - 1, Delim, _
PreString & Arr(i) & Delim, Rslt
Next i
End If
End Sub

Private Function NbrElements(Arr) As Integer
On Error Resume Next
NbrElements = UBound(Arr) - LBound(Arr) + 1
End Function
[/pre]
Narayan
 
Hi Narayan

Thanks for that I will pass it on to him. But that is it now we will go no further with it I have told him this will be the final one there will be no more so if he cannot get it to work tough. Anyway Many Thanks Narayan for your time and patience

Mike
 
Well said Luke.


The code in the last post by Narayan intrigues me on this line.

[pre]
Code: 
Dim a
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49)

which could be done with:

Dim b, c
With Application
b = .InputBox("Please input maximum number!", , , , , , 1)
c = .Transpose(Evaluate("=ROW(1:" & CStr(b) & ")"))
End With
[/pre]
Programmer's are generally lazy so why did he type so many numbers? Is there something obvious that I am missing?
 
Hi Shrivallabha ,


I think you have answered your question yourself !


The code is not mine ; I have mentioned that in my post.


If you see the original , the Array definition was already there for numbers till 17 ; extending it to 49 was easier than putting in your statements ! I am not a touch typist , and entering those numbers was much easier.


Narayan
 
Hi Luke

I have given him that and told him if he figures out how to select the correct numbers a big donation from him would not go amiss. Don't hold your breath I think we would have a better chance of flying to Mars and back than he has of picking the right numbers.

Mike
 
You must log in or register to reply here.
Back
Top