how to use code in excel 4

[hassified]

Hello people,
Some might have read where i was looking for a way to get a list of all possible permutations of the numbers 1-49 in six number combinations (like the lotto)and someone was good enough to post a code to do so in MS EXCEL and I belive this is the answer I needed, but I cannot get it to work. I would like for somone to give steps to get to work.
I tried some but kept getting an error, I don't I did right.

here is the code if anyone would like to try it themself.
Please E-Mail me if you get to work.

THANKS IN ADVANCE

Code starts here:

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
' Posted by Myrna Larson
' July 25, 2000
' Subject: Combin
'

Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096

Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case &quot;C&quot;
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case &quot;P&quot;
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If N > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = &quot;C&quot; Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If N = 0 Then
Which = &quot;Enter your data in a vertical range of at least 4 cells. &quot; _
& String$(2, 10) _
& &quot;Top cell must contain the letter C or P, 2nd cell is the number &quot;
_
& &quot;of items in a subset, the cells below are the values from which &quot;
_
& &quot;the subset is to be chosen.&quot;

Else
Which = &quot;This requires &quot; & Format$(N, &quot;#,##0&quot & _
&quot; cells, more than are available on the worksheet!&quot;
End If
MsgBox Which, vbOKOnly, &quot;DATA ERROR&quot;
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & &quot;, &quot; & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation

 

[cheerio]

The number of combinations is vaste which is why it is difficult to win the lotto. It is certainly well over the 64000 rows of an Excel workbook and I would guess it is over the 64000 * 256 cells in a workbook.

To test logic of code I would start with something less ambitious such as all pairs of numbers 1 to 10, all tripples of 1 to 10 etc. When that works you can loosen the parameters.

 

[xlbo]

We've been thru this 6 out of 49 is apprx 14.1 million
there are >16000000 cells in a worksheet - it should be ok (although very full) the prob here is that hassified can't get the code to work

Part of the prob, I think is that there are 3 private subs which look like they run from buttons, like you have to accept or reject the perm - not sure this code will be useful for this particular application

Rgds
Geoff

 

[Rujad]

hassified,
I got the above code to work fine. Set A1 to C,
A2 to 3 and A3 through A12 the numbers 1 through 10. When you run the macro you get the 120 possible combinations of the numbers 1 through 10 taken 3 at a time in column 1.
Now for the range of 1 to 49 taken 6 at a time the number of combinations (if my memory is correct) is a little over 10 Billion.
With my puny 750MHz, P3 (256MB) the macro took about 10 minutes to generate the first 470,000. Simple arithmetic estimates almost 150 days to complete the task. Meanwhile the screen is frozen. Is this your definition of getting an error or did you not set up the column of parameters as explained when you run the macro with a blank sheet?

 

[Rujad]

Boy,
Memory does fail. 14.1 million is closer. I revise my time to calculate the result down to 5 hours.

 

[sfvb]

There's 13,983,816

The formula for this is:
=FACT(49)/(FACT(49-6)*FACT(6))
or
49*48*47*46*45*44/(6*5*4*3*2*1)

 

[hassified]

Thanks, for your tips I still get errors though, I think I'm not using code right. I was told to Open Excel,Tools,Macro,Record New Macro. Now, I don't remember how but I got to a place where I could copy/paste the code and then run thats when I get the error message, and when I click ok on the message to make it go away thats when I see that something about &quot;buffer&quot; is highlighted and thats all I can do.
I feel so ignorant about this. I've got only a book that doesn't explaine and a personal friend, that thinks he knows it all,but doesn't. I've learned lately that there is more to excel than I ever thought.
I don't want someone to go out of their way or hold my hand through this but if someone could give me a better direction on setting up or the steps involved I would be so happy.