Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A is the Draw
Number, and Columns B:G are the 6 Drawn Numbers ( Excluding the Bonus
Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is the Draw
Number, and Columns B:H are the 7 ( Including Bonus Number ) Drawn
Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers (
Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of Memory.
Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k, l,
m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l,
m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data", Type:=8)
If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2, CStr(rITM.Value2)
Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ", Type:=1)
If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination Range",
Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim), "0.0e-0") &
_
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12), "0.0e-0") & _
" combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number & ")", _
vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A is the
Draw Number, and Columns B:G are the 6 Drawn Numbers ( Excluding the
Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is the Draw
Number, and Columns B:H are the 7 ( Including Bonus Number ) Drawn
Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers
( Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of Memory.
Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k,
l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l,
m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

correction..
you use 5 dimensions not 6
?49^5= 282.475.249 * 2 bytes per array


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


keepITcool wrote :



Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each

Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

http://groups-beta.google.com
permutations author:"myrna larson"

http://groups-beta.google.com/groups...r%3A%22myrna+l
arson%22

she has a nice example too.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of Memory
Error.
I will Look through the Code you Kindly gave and Try to get a Better
Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million Combinations and
Keep a Running Total ( Including & Excluding the Bonus Number ) of the
Number of Times Each 5 Number Combination has Appeared in the Total
Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data", Type:=8)
If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2, CStr(rITM.Value2)
Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ", Type:=1)
If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination Range",
Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim), "0.0e-0") &
_
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12), "0.0e-0") & _
" combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number & ")", _
vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A is the
Draw Number, and Columns B:G are the 6 Drawn Numbers ( Excluding the
Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is the Draw
Number, and Columns B:H are the 7 ( Including Bonus Number ) Drawn
Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers
( Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of Memory.
Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k,
l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l,
m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

Thanks for the Code by Myrna Larson, it Works Great ( and is Fast ) for
Producing Combinations & Permutations.
I Tried out the Code you Provided But Unfortunately it dose Not give me
the Required Results.
Thanks Anyway for your Help.

All the Best.
Paul

Has Anyone got Any Other Ideas on how to Solve this Out of Memory Error
7 Please.
The Code Kindly Provided by keepITcool Unfortunately does Not give me
the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of Memory
Error.
I will Look through the Code you Kindly gave and Try to get a Better
Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million Combinations and
Keep a Running Total ( Including & Excluding the Bonus Number ) of the
Number of Times Each 5 Number Combination has Appeared in the Total
Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data", Type:=8)
If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2, CStr(rITM.Value2)
Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ", Type:=1)
If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination Range",
Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim), "0.0e-0") &
_
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12), "0.0e-0") & _
" combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number & ")", _
vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A is the
Draw Number, and Columns B:G are the 6 Drawn Numbers ( Excluding the
Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is the Draw
Number, and Columns B:H are the 7 ( Including Bonus Number ) Drawn
Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers
( Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of Memory.
Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k,
l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l,
m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

Hi Again,

I have Tried Several Different Approaches to Solve this Problem But to
No Avail. If Anyone has Any Ideas on the Approach I should take it
would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of Memory Error
7 Please.
The Code Kindly Provided by keepITcool Unfortunately does Not give me
the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of Memory
Error.
I will Look through the Code you Kindly gave and Try to get a Better
Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million Combinations and
Keep a Running Total ( Including & Excluding the Bonus Number ) of the
Number of Times Each 5 Number Combination has Appeared in the Total
Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data", Type:=8)
If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2, CStr(rITM.Value2)
Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ", Type:=1)
If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination Range",
Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim), "0.0e-0") &
_
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12), "0.0e-0") & _
" combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number & ")", _
vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A is the
Draw Number, and Columns B:G are the 6 Drawn Numbers ( Excluding the
Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is the Draw
Number, and Columns B:H are the 7 ( Including Bonus Number ) Drawn
Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers
( Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of Memory.
Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k,
l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l,
m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to date.
I'll help but i need to know what your DrawsToDate looks like.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this Problem But to
No Avail. If Anyone has Any Ideas on the Approach I should take it
would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of Memory
Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately does Not give
me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of
Memory Error.
I will Look through the Code you Kindly gave and Try to get a
Better Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million
Combinations and Keep a Running Total ( Including & Excluding the
Bonus Number ) of the Number of Times Each 5 Number Combination
has Appeared in the Total Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data",
Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2,
CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ",
Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination
Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 = " &
_ Format$(Excel.WorksheetFunction.Combin(25, 12),
"0.0e-0") & _ " combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number & ")", _
vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A
is the Draw Number, and Columns B:G are the 6 Drawn Numbers (
Excluding the Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is
the Draw Number, and Columns B:H are the 7 ( Including Bonus
Number ) Drawn Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5
Numbers ( Including & Excluding the Bonus Number ) from 49 (
Combin(49,5) = 1,906,884 ) have Occurred in the Lotto Draws
to Date. The Code Below for Some Reason gives Error 7 Out of
Memory. Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value =
nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i,
j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

Hi keepITcool,

Thanks for the Reply.
In the Sheet Named NO Bonus in Cells A2:A? is the Draw Number. In Cells
B2:G? are the Numbers Drawn.
In the Sheet Named Bonus in Cells A2:A? is the Draw Number. In Cells
B2:H? are the Numbers Drawn ( Including the Bonus Number ).
As I said Before, I am New to VBA.

Thanks Very Much in Advance.
All the Best.
Paul



keepITcool wrote:
with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to date.
I'll help but i need to know what your DrawsToDate looks like.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this Problem But to
No Avail. If Anyone has Any Ideas on the Approach I should take it
would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of Memory
Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately does Not give
me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of
Memory Error.
I will Look through the Code you Kindly gave and Try to get a
Better Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million
Combinations and Keep a Running Total ( Including & Excluding the
Bonus Number ) of the Number of Times Each 5 Number Combination
has Appeared in the Total Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually need.
?49^6 13.841.287.201 elements.. of 2 bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data",
Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2,
CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ",
Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination
Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 = " &
_ Format$(Excel.WorksheetFunction.Combin(25, 12),
"0.0e-0") & _ " combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number & ")", _
vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In Sheet No Bonus, I have Titles in Cells A1:G1. In Column A
is the Draw Number, and Columns B:G are the 6 Drawn Numbers (
Excluding the Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A is
the Draw Number, and Columns B:H are the 7 ( Including Bonus
Number ) Drawn Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations of 5
Numbers ( Including & Excluding the Bonus Number ) from 49 (
Combin(49,5) = 1,906,884 ) have Occurred in the Lotto Draws
to Date. The Code Below for Some Reason gives Error 7 Out of
Memory. Any Help would be Appreciated.
Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value =
nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i,
j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

ok..
but what is your required output.
what do you want to know?
how do you want it stored/displayed

also note that since you are workiong with excel
the sets that can be effectively "documented"
are a bit cumbersome. since we have to work around the 65000 row limit.

I'd prefer to use access or a text file for documentation...


if it is a programming exercise.. I'm doing all the work here.
if you just want a proggie: many lotto proggies on the market...




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi keepITcool,

Thanks for the Reply.
In the Sheet Named NO Bonus in Cells A2:A? is the Draw Number. In
Cells B2:G? are the Numbers Drawn.
In the Sheet Named Bonus in Cells A2:A? is the Draw Number. In Cells
B2:H? are the Numbers Drawn ( Including the Bonus Number ).
As I said Before, I am New to VBA.

Thanks Very Much in Advance.
All the Best.
Paul



keepITcool wrote:
with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to date.
I'll help but i need to know what your DrawsToDate looks like.


--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this Problem
But to No Avail. If Anyone has Any Ideas on the Approach I should
take it would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of
Memory Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately does Not
give me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of
Memory Error.
I will Look through the Code you Kindly gave and Try to get a
Better Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million
Combinations and Keep a Running Total ( Including & Excluding
the Bonus Number ) of the Number of Times Each 5 Number
Combination has Appeared in the Total Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually
need. ?49^6 13.841.287.201 elements.. of 2
bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data",
Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2,
CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ",
Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination
Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 =
" & _ Format$(Excel.WorksheetFunction.Combin(25,
12), "0.0e-0") & _ " combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number &
")", _ vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named
Bonus. In Sheet No Bonus, I have Titles in Cells A1:G1.
In Column A is the Draw Number, and Columns B:G are the 6
Drawn Numbers ( Excluding the Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A
is the Draw Number, and Columns B:H are the 7 ( Including
Bonus Number ) Drawn Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations
of 5 Numbers ( Including & Excluding the Bonus Number )
from 49 ( Combin(49,5) = 1,906,884 ) have Occurred in the
Lotto Draws to Date. The Code Below for Some Reason
gives Error 7 Out of Memory. Any Help would be
Appreciated. Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500,
8).Select End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value =
nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value =
nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com
***

Thanks for the Reply keepITcool,

What I Ideally would like for the Output is, that on the Sheet Named
"Results", it Lists ALL the 5 Number Combinations Starting in Cells
A1:E1, then the Total Times Drawn ( Excluding the Bonus Number ) in
Cell F1, and the Total Times Drawn ( Including the Bonus Number ) in
Cell G1, then Miss a Column and Continue.
I Basically want to know how Many Times that ALL the Combinations of 5
Numbers from 49 Numbers ( 1,906,884 ) have Matched the 6 Number
Combinations in the Lotto to Date.
I have Tried to Account for the Fact that Excel has a Limitation of
Rows within Each Column by the Code :-
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
I have Followed the UK 649 Lotto for the Past 10 Years ( Trying to get
an Edge, in my Dreams ) and am Interested in the Results that this
Exercise Might Produce. This is Solely for my Interest and the
Statistics that will be Produced.

Thanks Once Again for Your Time on this.
All the Best.
Paul



keepITcool wrote:
ok..
but what is your required output.
what do you want to know?
how do you want it stored/displayed

also note that since you are workiong with excel
the sets that can be effectively "documented"
are a bit cumbersome. since we have to work around the 65000 row limit.

I'd prefer to use access or a text file for documentation...


if it is a programming exercise.. I'm doing all the work here.
if you just want a proggie: many lotto proggies on the market...




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi keepITcool,

Thanks for the Reply.
In the Sheet Named NO Bonus in Cells A2:A? is the Draw Number. In
Cells B2:G? are the Numbers Drawn.
In the Sheet Named Bonus in Cells A2:A? is the Draw Number. In Cells
B2:H? are the Numbers Drawn ( Including the Bonus Number ).
As I said Before, I am New to VBA.

Thanks Very Much in Advance.
All the Best.
Paul



keepITcool wrote:
with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to date.
I'll help but i need to know what your DrawsToDate looks like.


--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this Problem
But to No Avail. If Anyone has Any Ideas on the Approach I should
take it would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of
Memory Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately does Not
give me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any Out of
Memory Error.
I will Look through the Code you Kindly gave and Try to get a
Better Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million
Combinations and Keep a Running Total ( Including & Excluding
the Bonus Number ) of the Number of Times Each 5 Number
Combination has Appeared in the Total Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you actually
need. ?49^6 13.841.287.201 elements.. of 2
bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source data",
Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2,
CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups' ",
Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ", vbCritical
'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the Destination
Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _
" combinations." & _
vbNewLine & "A 'reasonable' maximum = " & "25/12 =
" & _ Format$(Excel.WorksheetFunction.Combin(25,
12), "0.0e-0") & _ " combinations.", vbCritical, _
"CombinationIndexer"
Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number &
")", _ vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other Named
Bonus. In Sheet No Bonus, I have Titles in Cells A1:G1.
In Column A is the Draw Number, and Columns B:G are the 6
Drawn Numbers ( Excluding the Bonus Number ).
In Sheet Bonus, I have Titles in Cells A1:H1. In Column A
is the Draw Number, and Columns B:H are the 7 ( Including
Bonus Number ) Drawn Numbers in Ascending Order.
The Results go into Sheet Results.
I am Trying to List the Number of Times ALL Combinations
of 5 Numbers ( Including & Excluding the Bonus Number )
from 49 ( Combin(49,5) = 1,906,884 ) have Occurred in the
Lotto Draws to Date. The Code Below for Some Reason
gives Error 7 Out of Memory. Any Help would be
Appreciated. Thanks in Advance.
Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500,
8).Select End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value =
nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value =
nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com
***

i cant follow your logic:
as I see it you DONT need an array of all possible combinations.

in fact you only want to check from the actual draws IF a draw occurred
multiple times (unlikely on 10 years* 52 draws.. at 84mio possibles..)


More interesting things missing from your requirements
(i still dont know if you need the complete array)

which numbers occur most
which number pairs occur often etc.

i'm not in the mood to write all the algoritms to efficiently do that.

Also note Excel is not the tool for stats on large populations..

IN your scenario each draw needs 5cells.
to "persist" 1.9 mio combinations (49,5) would require
9.534.420 cells.

but to persist the combinations of 49,6 you'd require
?application.combin(49,6) * 6
83.902.896
Sheet maximum is
?2^24
16.777.216

Thus persisting/storage must be changed to store each combin in 1 cell
as a string... BUT writing (unique) strings to excel is slow...
as is appears excel is internally indexing the strings somewhere...


I've tested writing 1.9mio strings to a worksheet but it gets very slow.
I found that writing to a csv file (shaped for 65536 lines),
and opening that is faster than doing it with code.. somewhere excel
bogs down... even if i write the strings in 4096 element blocks

still I cant see the use, except a an exercise to push excel to/beyond
it's limits...

as i said.. i give up... had a nice day playing and giving my procesor
a workout.


google for some shareware
must be there.




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Thanks for the Reply keepITcool,

What I Ideally would like for the Output is, that on the Sheet Named
"Results", it Lists ALL the 5 Number Combinations Starting in Cells
A1:E1, then the Total Times Drawn ( Excluding the Bonus Number ) in
Cell F1, and the Total Times Drawn ( Including the Bonus Number ) in
Cell G1, then Miss a Column and Continue.
I Basically want to know how Many Times that ALL the Combinations of 5
Numbers from 49 Numbers ( 1,906,884 ) have Matched the 6 Number
Combinations in the Lotto to Date.
I have Tried to Account for the Fact that Excel has a Limitation of
Rows within Each Column by the Code :-
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
I have Followed the UK 649 Lotto for the Past 10 Years ( Trying to get
an Edge, in my Dreams ) and am Interested in the Results that this
Exercise Might Produce. This is Solely for my Interest and the
Statistics that will be Produced.

Thanks Once Again for Your Time on this.
All the Best.
Paul



keepITcool wrote:
ok..
but what is your required output.
what do you want to know?
how do you want it stored/displayed

also note that since you are workiong with excel
the sets that can be effectively "documented"
are a bit cumbersome. since we have to work around the 65000 row
limit.

I'd prefer to use access or a text file for documentation...


if it is a programming exercise.. I'm doing all the work here.
if you just want a proggie: many lotto proggies on the market...




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi keepITcool,

Thanks for the Reply.
In the Sheet Named NO Bonus in Cells A2:A? is the Draw Number. In
Cells B2:G? are the Numbers Drawn.
In the Sheet Named Bonus in Cells A2:A? is the Draw Number. In
Cells B2:H? are the Numbers Drawn ( Including the Bonus Number ).
As I said Before, I am New to VBA.

Thanks Very Much in Advance.
All the Best.
Paul



keepITcool wrote:
with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to date.
I'll help but i need to know what your DrawsToDate looks like.


--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this
Problem But to No Avail. If Anyone has Any Ideas on the
Approach I should take it would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of
Memory Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately does
Not give me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any
Out of Memory Error.
I will Look through the Code you Kindly gave and Try to
get a Better Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million
Combinations and Keep a Running Total ( Including &
Excluding the Bonus Number ) of the Number of Times Each
5 Number Combination has Appeared in the Total Draws to
Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you
actually need. ?49^6 13.841.287.201 elements.. of 2
bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source
data", Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2,
CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups'
", Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ",
vbCritical 'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the
Destination Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with "
& _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _ " combinations." & _
vbNewLine & "A 'reasonable' maximum = " &
"25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12),
"0.0e-0") & _ " combinations.", vbCritical, _
"CombinationIndexer" Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number &
")", _ vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other
Named Bonus. In Sheet No Bonus, I have Titles in
Cells A1:G1. In Column A is the Draw Number, and
Columns B:G are the 6 Drawn Numbers ( Excluding the
Bonus Number ). In Sheet Bonus, I have Titles in
Cells A1:H1. In Column A is the Draw Number, and
Columns B:H are the 7 ( Including Bonus Number )
Drawn Numbers in Ascending Order. The Results go
into Sheet Results. I am Trying to List the Number
of Times ALL Combinations of 5 Numbers ( Including &
Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of
Memory. Any Help would be Appreciated. Thanks in
Advance. Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5))
= _ nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(5)) + 1 nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(4), nNo(6)) = _ nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(4), nNo(6)) + 1 nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5))
= _ nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(5)) + 1 nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(4), nNo(6)) = _ nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(4), nNo(6)) + 1 nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500,
8).Select End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value =
nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value =
nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex
http://www.developersdex.com ***

Thanks Again for the Reply keepITcool,

I can see what you are Suggesting and it does make More Sense. I do NOT
Need to List ALL 1.9 Million Combinations, Just those that have
Occurred..
Each 6 Number Combination Contains 6 FIVE Number Combinations (
Combin(6,5) = 6 Combinations ).
How can I get it to List ALL the 5 Numbers Combinations that have
Appeared in the Lotto to Date AND the Total Times Drawn Including AND
Excluding the Bonus Number.
Thanks for your Time and Effort on this.
All the Best.
Paul



keepITcool wrote:
i cant follow your logic:
as I see it you DONT need an array of all possible combinations.

in fact you only want to check from the actual draws IF a draw occurred
multiple times (unlikely on 10 years* 52 draws.. at 84mio possibles..)


More interesting things missing from your requirements
(i still dont know if you need the complete array)

which numbers occur most
which number pairs occur often etc.

i'm not in the mood to write all the algoritms to efficiently do that.

Also note Excel is not the tool for stats on large populations..

IN your scenario each draw needs 5cells.
to "persist" 1.9 mio combinations (49,5) would require
9.534.420 cells.

but to persist the combinations of 49,6 you'd require
?application.combin(49,6) * 6
83.902.896
Sheet maximum is
?2^24
16.777.216

Thus persisting/storage must be changed to store each combin in 1 cell
as a string... BUT writing (unique) strings to excel is slow...
as is appears excel is internally indexing the strings somewhere...


I've tested writing 1.9mio strings to a worksheet but it gets very slow.
I found that writing to a csv file (shaped for 65536 lines),
and opening that is faster than doing it with code.. somewhere excel
bogs down... even if i write the strings in 4096 element blocks

still I cant see the use, except a an exercise to push excel to/beyond
it's limits...

as i said.. i give up... had a nice day playing and giving my procesor
a workout.


google for some shareware
must be there.




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Thanks for the Reply keepITcool,

What I Ideally would like for the Output is, that on the Sheet Named
"Results", it Lists ALL the 5 Number Combinations Starting in Cells
A1:E1, then the Total Times Drawn ( Excluding the Bonus Number ) in
Cell F1, and the Total Times Drawn ( Including the Bonus Number ) in
Cell G1, then Miss a Column and Continue.
I Basically want to know how Many Times that ALL the Combinations of 5
Numbers from 49 Numbers ( 1,906,884 ) have Matched the 6 Number
Combinations in the Lotto to Date.
I have Tried to Account for the Fact that Excel has a Limitation of
Rows within Each Column by the Code :-
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
I have Followed the UK 649 Lotto for the Past 10 Years ( Trying to get
an Edge, in my Dreams ) and am Interested in the Results that this
Exercise Might Produce. This is Solely for my Interest and the
Statistics that will be Produced.

Thanks Once Again for Your Time on this.
All the Best.
Paul



keepITcool wrote:
ok..
but what is your required output.
what do you want to know?
how do you want it stored/displayed

also note that since you are workiong with excel
the sets that can be effectively "documented"
are a bit cumbersome. since we have to work around the 65000 row
limit.

I'd prefer to use access or a text file for documentation...


if it is a programming exercise.. I'm doing all the work here.
if you just want a proggie: many lotto proggies on the market...




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi keepITcool,

Thanks for the Reply.
In the Sheet Named NO Bonus in Cells A2:A? is the Draw Number. In
Cells B2:G? are the Numbers Drawn.
In the Sheet Named Bonus in Cells A2:A? is the Draw Number. In
Cells B2:H? are the Numbers Drawn ( Including the Bonus Number ).
As I said Before, I am New to VBA.

Thanks Very Much in Advance.
All the Best.
Paul



keepITcool wrote:
with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to date.
I'll help but i need to know what your DrawsToDate looks like.


--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this
Problem But to No Avail. If Anyone has Any Ideas on the
Approach I should take it would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out of
Memory Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately does
Not give me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without Any
Out of Memory Error.
I will Look through the Code you Kindly gave and Try to
get a Better Understanding of what is Happening and Why.
I Basically just want it to go through ALL 1.9 Million
Combinations and Keep a Running Total ( Including &
Excluding the Bonus Number ) of the Number of Times Each
5 Number Combination has Appeared in the Total Draws to
Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you
actually need. ?49^6 13.841.287.201 elements.. of 2
bytes(integer) each


More efficient code for combinations (NOT permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T, "0.0\s\.")
End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source
data", Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add rITM.Value2,
CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups'
", Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ",
vbCritical 'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the
Destination Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal with "
& _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _ " combinations." & _
vbNewLine & "A 'reasonable' maximum = " &
"25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12),
"0.0e-0") & _ " combinations.", vbCritical, _
"CombinationIndexer" Case Else
MsgBox Err.Description & vbTab & "(" & Err.Number &
")", _ vbCritical, "CombinationIndexer"
End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other
Named Bonus. In Sheet No Bonus, I have Titles in
Cells A1:G1. In Column A is the Draw Number, and
Columns B:G are the 6 Drawn Numbers ( Excluding the
Bonus Number ). In Sheet Bonus, I have Titles in
Cells A1:H1. In Column A is the Draw Number, and
Columns B:H are the 7 ( Including Bonus Number )
Drawn Numbers in Ascending Order. The Results go
into Sheet Results. I am Trying to List the Number
of Times ALL Combinations of 5 Numbers ( Including &
Excluding the Bonus Number ) from 49 ( Combin(49,5) =
1,906,884 ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives Error 7 Out of
Memory. Any Help would be Appreciated. Thanks in
Advance. Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5))
= _ nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(5)) + 1 nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(4), nNo(6)) = _ nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(4), nNo(6)) + 1 nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5))
= _ nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(5)) + 1 nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(4), nNo(6)) = _ nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(4), nNo(6)) + 1 nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500,
8).Select End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value =
nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value =
nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex
http://www.developersdex.com ***

Paul,

i may get back on this...
i bookmarked it.. no time/inclination at present
will email when i got s'thing

cheerz!

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Thanks Again for the Reply keepITcool,

I can see what you are Suggesting and it does make More Sense. I do
NOT Need to List ALL 1.9 Million Combinations, Just those that have
Occurred..
Each 6 Number Combination Contains 6 FIVE Number Combinations (
Combin(6,5) = 6 Combinations ).
How can I get it to List ALL the 5 Numbers Combinations that have
Appeared in the Lotto to Date AND the Total Times Drawn Including AND
Excluding the Bonus Number.
Thanks for your Time and Effort on this.
All the Best.
Paul



keepITcool wrote:
i cant follow your logic:
as I see it you DONT need an array of all possible combinations.

in fact you only want to check from the actual draws IF a draw
occurred multiple times (unlikely on 10 years* 52 draws.. at 84mio
possibles..)


More interesting things missing from your requirements
(i still dont know if you need the complete array)

which numbers occur most
which number pairs occur often etc.

i'm not in the mood to write all the algoritms to efficiently do
that.

Also note Excel is not the tool for stats on large populations..

IN your scenario each draw needs 5cells.
to "persist" 1.9 mio combinations (49,5) would require
9.534.420 cells.

but to persist the combinations of 49,6 you'd require
?application.combin(49,6) * 6
83.902.896
Sheet maximum is
?2^24
16.777.216

Thus persisting/storage must be changed to store each combin in 1
cell as a string... BUT writing (unique) strings to excel is slow...
as is appears excel is internally indexing the strings somewhere...


I've tested writing 1.9mio strings to a worksheet but it gets very
slow. I found that writing to a csv file (shaped for 65536 lines),
and opening that is faster than doing it with code.. somewhere excel
bogs down... even if i write the strings in 4096 element blocks

still I cant see the use, except a an exercise to push excel
to/beyond it's limits...

as i said.. i give up... had a nice day playing and giving my
procesor a workout.


google for some shareware
must be there.




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Thanks for the Reply keepITcool,

What I Ideally would like for the Output is, that on the Sheet
Named "Results", it Lists ALL the 5 Number Combinations Starting
in Cells A1:E1, then the Total Times Drawn ( Excluding the Bonus
Number ) in Cell F1, and the Total Times Drawn ( Including the
Bonus Number ) in Cell G1, then Miss a Column and Continue.
I Basically want to know how Many Times that ALL the Combinations
of 5 Numbers from 49 Numbers ( 1,906,884 ) have Matched the 6
Number Combinations in the Lotto to Date.
I have Tried to Account for the Fact that Excel has a Limitation
of Rows within Each Column by the Code :-
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
I have Followed the UK 649 Lotto for the Past 10 Years ( Trying
to get an Edge, in my Dreams ) and am Interested in the Results
that this Exercise Might Produce. This is Solely for my Interest
and the Statistics that will be Produced.

Thanks Once Again for Your Time on this.
All the Best.
Paul



keepITcool wrote:
ok..
but what is your required output.
what do you want to know?
how do you want it stored/displayed

also note that since you are workiong with excel
the sets that can be effectively "documented"
are a bit cumbersome. since we have to work around the 65000 row
limit.

I'd prefer to use access or a text file for documentation...


if it is a programming exercise.. I'm doing all the work here.
if you just want a proggie: many lotto proggies on the market...




--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi keepITcool,

Thanks for the Reply.
In the Sheet Named NO Bonus in Cells A2:A? is the Draw
Number. In Cells B2:G? are the Numbers Drawn.
In the Sheet Named Bonus in Cells A2:A? is the Draw Number. In
Cells B2:H? are the Numbers Drawn ( Including the Bonus
Number ). As I said Before, I am New to VBA.

Thanks Very Much in Advance.
All the Best.
Paul



keepITcool wrote:
with my code:

get the 1.9mio combinations with
dim aByt() as byte
abyt = combinationindexer(49,5)

on my laptop this runs without problems in 3.7 seconds.

then loop the array and compare to an array of draws to
date. I'll help but i need to know what your DrawsToDate
looks like.


--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

Hi Again,

I have Tried Several Different Approaches to Solve this
Problem But to No Avail. If Anyone has Any Ideas on the
Approach I should take it would be Greatly Appreciated.
Thanks in Advance.
All the Best.
Paul



Paul Black wrote:
Has Anyone got Any Other Ideas on how to Solve this Out
of Memory Error 7 Please.
The Code Kindly Provided by keepITcool Unfortunately
does Not give me the Required Results.
Thanks in Advance.
All the Best.
Paul



wrote:
Hi keepITcool,

As you Probably Realised I am New to Programming.
The Program I did for 4 Numbers Worked Well Without
Any Out of Memory Error.
I will Look through the Code you Kindly gave and Try
to get a Better Understanding of what is Happening
and Why. I Basically just want it to go through ALL
1.9 Million Combinations and Keep a Running Total (
Including & Excluding the Bonus Number ) of the
Number of Times Each 5 Number Combination has
Appeared in the Total Draws to Date.

Thanks Again for the Code.
All the Best.
Paul



keepITcool wrote:
Nice memory hog!

your arrays are a little bit bigger than what you
actually need. ?49^6 13.841.287.201 elements..
of 2 bytes(integer) each


More efficient code for combinations (NOT
permutations).

Option Explicit
Sub ACombiTester()
Dim x, T!
T = Timer
x = CombinationIndexer(25, 12)
MsgBox UBound(x) & vbTab & Format$(Timer - T,
"0.0\s\.") End Sub

Sub CreateCombinations()
'keepITcool 2004/11/01

Dim rSrc As Range, rDst As Range, rITM As Range
Dim cItm As Collection, vItm()
Dim aIdx() As Byte, vRes()
Dim nItm&, nDim&, nCnt&
Dim r&, c&


Set rSrc = Application.InputBox("Select the Source
data", Type:=8) If rSrc Is Nothing Then
Beep
Exit Sub
End If
'Create a collection of unique items in range.
Set cItm = New Collection
On Error Resume Next
For Each rITM In rSrc.Cells
If rITM < vbNullString Then cItm.Add
rITM.Value2, CStr(rITM.Value2) Next
nItm = cItm.Count
ReDim vItm(1 To nItm)
For r = 1 To nItm
vItm(r) = cItm(r)
Next
On Error GoTo 0

Let nDim = Application.InputBox("Size of 'groups'
", Type:=1) If nDim < 1 Or nDim nItm Then
Beep
Exit Sub
End If

'Get the number of combinations
nCnt = Application.Combin(nItm, nDim)
If nCnt Rows.Count Then
MsgBox nCnt & " combinations...Wont fit :( ",
vbCritical 'Exit Sub
End If
'Create the index array
ReDim aIdx(0 To 2, 1 To nDim) As Byte
'Create the result array
ReDim vRes(1 To nCnt, 1 To nDim)
'min on first row, max on last row
For c = 1 To nDim
aIdx(0, c) = c
aIdx(2, c) = nItm - nDim + c
vRes(1, c) = vItm(aIdx(0, c))
vRes(nCnt, c) = vItm(aIdx(2, c))
Next
For r = 2 To nCnt - 1
aIdx(1, nDim) = aIdx(0, nDim) + 1
For c = 1 To nDim - 1
If aIdx(0, c + 1) = aIdx(2, c + 1) Then
aIdx(1, c) = aIdx(0, c) + 1
Else
aIdx(1, c) = aIdx(0, c)
End If
Next
For c = 2 To nDim
If aIdx(1, c) aIdx(2, c) Then
aIdx(1, c) = aIdx(1, c - 1) + 1
End If
Next
For c = 1 To nDim
aIdx(0, c) = aIdx(1, c)
vRes(r, c) = vItm(aIdx(1, c))
Next
Next


dump:
Set rDst = Application.InputBox("Select the
Destination Range", Type:=8)
If rDst Is Nothing Then
Beep
Exit Sub
End If
If Rows.Count - rDst.Row < nCnt Then
Stop
ElseIf Columns.Count - rDst.Column < nDim Then
Stop
End If
With rDst
.CurrentRegion.Clear
.Resize(nCnt, nDim) = vRes
End With


End Sub


Function CombinationIndexer(ByVal nItm As Byte, _
ByVal nDim As Byte) As Byte()
Dim aIdx() As Byte, nCnt&, r&, c&
'Create the index array
On Error GoTo errH:
nCnt = Excel.WorksheetFunction.Combin(nItm, nDim)
ReDim aIdx(1 To nCnt, 1 To nDim)

'min on first row, max on last row
For c = 1 To nDim
aIdx(1, c) = c
aIdx(nCnt, c) = nItm - nDim + c
Next
For r = 2 To nCnt - 1
aIdx(r, nDim) = aIdx(r - 1, nDim) + 1
For c = 1 To nDim - 1
If aIdx(r - 1, c + 1) = aIdx(nCnt, c + 1) Then
aIdx(r, c) = aIdx(r - 1, c) + 1
Else
aIdx(r, c) = aIdx(r - 1, c)
End If
Next
For c = 2 To nDim
If aIdx(r, c) aIdx(nCnt, c) Then
aIdx(r, c) = aIdx(r, c - 1) + 1
End If
Next
Next

CombinationIndexer = aIdx
Exit Function
errH:
Select Case Err
Case 6, 7 'Out of memory/Overflow
MsgBox "This machine isn't equipped to deal
with " & _
Format$(Excel.WorksheetFunction.Combin(nItm, nDim),
"0.0e-0") & _ " combinations." & _
vbNewLine & "A 'reasonable' maximum = " &
"25/12 = " & _
Format$(Excel.WorksheetFunction.Combin(25, 12),
"0.0e-0") & _ " combinations.", vbCritical,
_ "CombinationIndexer" Case Else
MsgBox Err.Description & vbTab & "(" &
Err.Number & ")", _ vbCritical,
"CombinationIndexer" End Select
ReDim CombinationIndexer(0, 0)

End Function




--
keepITcool
www.XLsupport.com | keepITcool chello nl |
amsterdam


Paul Black wrote :

Hi Everyone,

I have Two Sheets, One Named No Bonus & the Other
Named Bonus. In Sheet No Bonus, I have Titles in
Cells A1:G1. In Column A is the Draw Number, and
Columns B:G are the 6 Drawn Numbers ( Excluding
the Bonus Number ). In Sheet Bonus, I have
Titles in Cells A1:H1. In Column A is the Draw
Number, and Columns B:H are the 7 ( Including
Bonus Number ) Drawn Numbers in Ascending Order.
The Results go into Sheet Results. I am Trying
to List the Number of Times ALL Combinations of 5
Numbers ( Including & Excluding the Bonus Number
) from 49 ( Combin(49,5) = 1,906,884 ) have
Occurred in the Lotto Draws to Date. The Code
Below for Some Reason gives Error 7 Out of
Memory. Any Help would be Appreciated. Thanks
in Advance. Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(5)) = _ nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(4), nNo(5)) + 1 nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(4), nNo(6)) = _ nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6))
= _ nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5),
nNo(6)) + 1 nNoBonus(nNo(1), nNo(2), nNo(4),
nNo(5), nNo(6)) = _ nNoBonus(nNo(1), nNo(2),
nNo(4), nNo(5), nNo(6)) + 1 nNoBonus(nNo(1),
nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6))
+ 1 nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5),
nNo(6)) = _ nNoBonus(nNo(2), nNo(3), nNo(4),
nNo(5), nNo(6)) + 1 Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(5)) = _ nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(4), nNo(5)) + 1 nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(4), nNo(6)) = _ nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7))
= _ nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4),
nNo(7)) + 1 nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(5), nNo(6)) = _ nNoBonus(nNo(1), nNo(2),
nNo(3), nNo(5), nNo(6)) + 1 nNoBonus(nNo(1),
nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7))
+ 1 nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6),
nNo(7)) = _ nNoBonus(nNo(1), nNo(2), nNo(3),
nNo(6), nNo(7)) + 1 nNoBonus(nNo(1), nNo(2),
nNo(4), nNo(5), nNo(6)) = _ nNoBonus(nNo(1),
nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7))
= _ nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5),
nNo(7)) + 1 nNoBonus(nNo(1), nNo(2), nNo(4),
nNo(6), nNo(7)) = _ nNoBonus(nNo(1), nNo(2),
nNo(4), nNo(6), nNo(7)) + 1 nNoBonus(nNo(1),
nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7))
+ 1 nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5),
nNo(6)) = _ nNoBonus(nNo(1), nNo(3), nNo(4),
nNo(5), nNo(6)) + 1 nNoBonus(nNo(1), nNo(3),
nNo(4), nNo(5), nNo(7)) = _ nNoBonus(nNo(1),
nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7))
= _ nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6),
nNo(7)) + 1 nNoBonus(nNo(1), nNo(3), nNo(5),
nNo(6), nNo(7)) = _ nNoBonus(nNo(1), nNo(3),
nNo(5), nNo(6), nNo(7)) + 1 nNoBonus(nNo(1),
nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7))
+ 1 nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5),
nNo(6)) = _ nNoBonus(nNo(2), nNo(3), nNo(4),
nNo(5), nNo(6)) + 1 nNoBonus(nNo(2), nNo(3),
nNo(4), nNo(5), nNo(7)) = _ nNoBonus(nNo(2),
nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7))
= _ nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6),
nNo(7)) + 1 nNoBonus(nNo(2), nNo(3), nNo(5),
nNo(6), nNo(7)) = _ nNoBonus(nNo(2), nNo(3),
nNo(5), nNo(6), nNo(7)) + 1 nNoBonus(nNo(2),
nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7))
+ 1 nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6),
nNo(7)) = _ nNoBonus(nNo(3), nNo(4), nNo(5),
nNo(6), nNo(7)) + 1 Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500,
8).Select End If
ActiveCell.Offset(0, 0).Value
= i ActiveCell.Offset(0,
1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k,
l, m) ActiveCell.Offset(0,
6).Value = nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
Paul



*** Sent via Developersdex
http://www.developersdex.com ***