Out of Memory Error 7

[Paul Black]

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

 

[keepITcool]

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 :

 

[keepITcool]

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 :

 

[keepITcool]

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

http://groups-beta.google.com/groups?q=permutations++author:"myrna+l
arson%22

she has a nice example too.

 

[paul_black27]

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

 

[Paul Black]

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

 

[Paul Black]

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

 

[Paul Black]

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

 

[keepITcool]

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 :

 

[Paul Black]

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]

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 :

 

[Paul Black]

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]

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 :

 

[Paul Black]

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]

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 :