Hi
I only changed 2 things:
- now the code at the beginning clears all columns from D to the right
- if the total number of permutations/combinations is bigger than the total cells in a column, the code continues to write in groups of columns to the right
Remark: permutations/combinations deal with powers and factorials and so it's very easy to get values in the order of millions and so even this solution will not work when the whole worksheet is full. In those cases you'd have to change the way the result is written, like continuing in another worksheet or write a CSV file.
Try:
Code:
Option Explicit
' PGC Set 2007
' Calculates and writes the Combinations / Permutations with/without repetition
' Assumes the result is written from row 1 down. If the total number of cells in a column
' is less than tha number of results continues in another group of columns to the right.
' vElements - Array with the set elements (1 to n)
' p - number of elements in 1 combination/permutation
' bComb - True: Combinations, False: Permutations
' bRepet - True: with repetition, False: without repetition
' vResult - Array to hold 1 permutation/combination (1 to p)
' lRow - row number. the next combination/permutation is written in lRow+1
' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
' iElement - order of the element to process in case of combination
' iIndex - position of the next element in the combination/permutation
' Sub CombPerm() deals with the input / output
' Sub CombPermNP() generates the combinations / permutations
Sub CombPerm()
Dim rRng As Range, p As Integer
Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
Dim lRow As Long, bComb As Boolean, bRepet As Boolean
Dim vResultPart, iGroup As Integer, l As Long, lMax As Long, k As Long
' Get the inputs and clear the result range (you may adjust for other locations)
Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked
bComb = Range("B2")
bRepet = Range("B3")
Range("D1", Cells(1, Columns.Count)).EntireColumn.Clear
' Error
If (Not bRepet) And (rRng.Count < p) Then
MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"
Exit Sub
End If
' Set up the arrays for the set elements and the result
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
With Application.WorksheetFunction
If bComb = True Then
lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
Else
If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
End If
End With
ReDim vResult(1 To p)
ReDim vResultAll(1 To lTotal, 1 To p)
' Calculate the Combinations / Permutations
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)
' Write the Combinations / Permutations
' Since writing to the worksheet cell be cell is very slow, uses temporary arrays to write one column at a time
Application.ScreenUpdating = False
If lTotal <= Rows.Count Then
Range("D1").Resize(lTotal, p).Value = vResultAll
Else
While iGroup * Rows.Count < lTotal
lMax = lTotal - iGroup * Rows.Count
If lMax > Rows.Count Then lMax = Rows.Count
ReDim vResultPart(1 To lMax, 1 To p)
For l = 1 To lMax
For k = 1 To p
vResultPart(l, k) = vResultAll(l + iGroup * Rows.Count, k)
Next k
Next
Range("D1").Offset(0, iGroup * (p + 1)).Resize(lMax, p).Value = vResultPart
iGroup = iGroup + 1
Wend
End If
Application.ScreenUpdating = True
End Sub
Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
ByVal vResult As Variant, ByRef lRow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
Dim i As Integer, j As Integer, bSkip As Boolean
For i = IIf(bComb, iElement, 1) To UBound(vElements)
bSkip = False
' in case of permutation without repetition makes sure the element is not yet used
If (Not bComb) And Not bRepet Then
For j = 1 To p
If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
bSkip = True
Exit For
End If
Next
End If
If Not bSkip Then
vResult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
For j = 1 To p
vResultAll(lRow, j) = vResult(j)
Next j
Else
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
End If
End If
Next i
End Sub
Ex.
[TABLE="width: 2"]
<tbody>[TR]
[TH][/TH]
[TH="align: center"]A[/TH]
[TH="align: center"]B[/TH]
[TH="width: 30, align: center"]C[/TH]
[TH="width: 30, align: center"]D[/TH]
[TH="width: 30, align: center"]E[/TH]
[TH="width: 30, align: center"]F[/TH]
[TH="width: 30, align: center"]G[/TH]
[TH="width: 30, align: center"]H[/TH]
[TH="width: 30, align: center"]I[/TH]
[TH="width: 30, align: center"]J[/TH]
[TH="width: 30, align: center"]K[/TH]
[TH="width: 30, align: center"]L[/TH]
[TH="width: 30, align: center"]M[/TH]
[TH="width: 30, align: center"]N[/TH]
[TH="width: 30, align: center"]O[/TH]
[TH="width: 30, align: center"]P[/TH]
[TH="width: 30, align: center"]Q[/TH]
[/TR]
[TR]
[TD="align: center"]
1[/TD]
[TD="align: left"]p[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
2[/TD]
[TD="align: left"]Combinations[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
3[/TD]
[TD="align: left"]Repetition[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
5[/TD]
[TD="align: left"]Set[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
6[/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
7[/TD]
[TD="align: right"][/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
8[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
9[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
10[/TD]
[TD="align: right"][/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
11[/TD]
[TD="align: right"][/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
12[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
13[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
14[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]
15[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="colspan: 18"] [Book1]Sheet1[/TD]
[/TR]
</tbody>[/TABLE]
In this case the first group of columns is written until the last row and the second group until row 52113, making a total of 117649 permutations (using xl2000, 64K cells/column).