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 ***

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
> > >
> > >
> > >
> > > 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 ***

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
> > > >
> > > >
> > > >
> > > > 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
> > > > > > > ***

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
> > > > >
> > > > >
> > > > >
> > > > > 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
> > > > > > > > ***

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
> > > > > >
> > > > > >
> > > > > >
> > > > > > 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 ***

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
> > > > > > >
> > > > > > >
> > > > > > >
> > > > > > > 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 ***

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
> > > > > > > >
> > > > > > > >
> > > > > > > >
> > > > > > > > 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 ***