Out of Memory Error 7

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



paul_black27@hotmail.com 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
>
>
>
> paul_black27@hotmail.com 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
> >
> >
> >
> > paul_black27@hotmail.com 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 ***