I guess only super computer can solve this

[mac_see]

Ekim from MrExcel.com has directed me to a below given code from Myrn
Larson (Microsoft MVP). I want some modifications done to that code.

What I did is:
--------------
1. Typed "C" in cell A1 of Sheet1
2. Typed "4" in cell A2 of sheet1
3. Typed 1, 4, 5, 19, 21, 24, 30, 31, 37, 40, 44, 46, 48, 50, 53, 57
58, 62, 72 & 76 vertically in the range A3:A22
4. Ran the ListPermutationsOrCombinations() Macro
5. Got 4845 combinations in sheet4 i.e., all combinations of 4 each o
the above provided numbers in step # 3

Similarly I want to make all combinations of 80 numbers of 8 each i.e.
combin(80,8)=28987537150 using the above code. 28987537150 is a ver
big figure and will not fit in Excel therefore I thought of narrowin
it down.

What I did further is:
----------------------
1. Deleted everything from Sheet1. Kept the results of sheet4 as it is

2. Typed "C" in cell A1 of Sheet1
3. Typed "8" in cell A2 of sheet1
4. Typed numbers from 1-80 vertically in the range A3:A82
5. Ran the ListPermutationsOrCombinations() Macro but it gave an erro
because 28987537150 result will not fit in excel worksheet.


Criteria:
---------
If I want to get all combinations of 80 numbers of 8 each, the belo
code will give the first combination as 1, 2, 3, 4, 5, 6, 7 & 8. No
before putting this combination in Cell A1 of sheet 5, it shoul
compare this combination of 8 numbers with all 4845 combinations tha
we have in sheet4 (i.e., 1, 2, 3, 4, 5, 6, 7 & 8 will be compared wit
1, 4, 5 & 19 / 1, 4, 5 & 21 / 1, 4, 5 & 24 and so on). If it find
atleast one combination out of those 4845 that has all 4 number
present in this combination of 8 then only it should consider thi
combination and put it in cell A1 of sheet5 else, go and check the nex
combination i.e., 1, 2, 3, 4, 5, 6, 7 & 9. The loop should continu
till the 28987537150th (last) combination. For instance, when yo
compare 1, 2, 3, 4, 5, 6, 7 & 8 with 1, 4, 5 & 19, only three number
matches 1, 4 and 5. The 4th number 19 is not present in the combinatio
of 8 numbers therefore this combination will not be considered vali
hence the loop should move to the next combination 1, 2, 3, 4, 5, 6,
& 9 and the same thing should happen till the last combinatio
(28987537150th)

I hope I have explained the scenerio in clear and simple words. Ca
anyone edit the below code that satisfies my criteria? Would appreciat
if anyone helps me out for looking up a workable solution for this.

Maxi

*****************************************************

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc

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

Worksheets("Sheet1").Range("A1").Select
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

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

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

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

Application.ScreenUpdating = False

Set Results = Worksheets.Add

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

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

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

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

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

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

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

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

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

End Sub 'AddPermutation

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

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

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

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

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

End Sub 'AddCombination

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

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

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

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

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

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

End If

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

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

 

[Harlan Grove]

...
...

Similarly I want to make all combinations of 80 numbers of 8 each i.e.,
combin(80,8)=28987537150 using the above code. 28987537150 is a very
big figure and will not fit in Excel therefore I thought of narrowing
it down.

...

Let's format that large number: 28,987,537,150. It's very, very likely you lack
sufficient disk space to store that many combinations of 8 numbers drawn from a
population of 80 numbers. Even using 8 bytes per combination, in packed records
without field or record separators, you'd need 231,900,297,200 bytes of disk
storage.

As for storing these combinations in an Excel workbook, you'd need 1728
worksheets to store them, and you'd have to contend with memory overhead for
cells and worksheets. I'd figure you'd need 500GB RAM to have a prayer of
managing this (if Excel were remotely capable of this). 500GB is about 100 times
more RAM than current very high end (read: extremely expensive) Windows-capable
machines can hold.

Then there's the question of what you intend to do with these almost 29 billion
combinations once you have them. You are about to make the mistake of wasting
lots of resources generating a dataset that's about 4 decimal orders of
magnitude too large to work with practically on PCs. If you had several
gigabytes of RAM and terabytes of fast disk storage as well as software that's
much more efficient at memory access than Excel, you might have a chance to do
something nontrivial with this many combinations. With even a high-end PC, you
haven't got a prayer of doing anything useful.