Hello,
I am working with PGC, code since long time but some how I need help, please can the code can be modified to write output result in a single column separated by "," instead of in multiple columns.
Here below is an example with the code attached how the code output result prints in 4 columns D, E, F &G
I want the result output in a single column "D" separated by coma ",". Like as "A, A, A, A"
Thank you all.
I am using Excel 2000
Regards,
Moti
I am working with PGC, code since long time but some how I need help, please can the code can be modified to write output result in a single column separated by "," instead of in multiple columns.
Here below is an example with the code attached how the code output result prints in 4 columns D, E, F &G
I want the result output in a single column "D" separated by coma ",". Like as "A, A, A, A"
| * | A | B | C | D | E | F | G | H | I |
| 1 | P | 4 | |||||||
| 2 | Combinations | FALSE | |||||||
| 3 | Repetition | TRUE | |||||||
| 4 | |||||||||
| 5 | Set Col B5 Down | A | |||||||
| 6 | B | A | A | A | A | ||||
| 7 | C | A | A | A | B | ||||
| 8 | A | A | A | C | |||||
| 9 | A | A | B | A | |||||
| 10 | A | A | B | B | |||||
| 11 | A | A | B | C | |||||
| 12 | A | A | C | A | |||||
| 13 | A | A | C | B | |||||
| 14 | A | A | C | C | |||||
| 15 | A | B | A | A | |||||
| 16 | A | B | A | B | |||||
| 17 | A | B | A | C | |||||
| 18 | A | B | B | A | |||||
| 19 | A | B | B | B | |||||
| 20 | A | B | B | C | |||||
| 21 | A | B | C | A | |||||
| 22 | A | B | C | B | |||||
| 23 | A | B | C | C | |||||
| 24 | A | C | A | A | |||||
| 25 | A | C | A | B | |||||
| 26 | A | C | A | C | |||||
| 27 | A | C | B | A | |||||
| 28 | A | C | B | B | |||||
| 29 | A | C | B | C | |||||
| 30 | A | C | C | A | |||||
| 31 | A | C | C | B | |||||
| 32 | A | C | C | C | |||||
| 33 | B | A | A | A | |||||
| 34 | B | A | A | B | |||||
| 35 | B | A | A | C | |||||
| 36 | B | A | B | A | |||||
| 37 | B | A | B | B | |||||
| 38 | B | A | B | C | |||||
| 39 | B | A | C | A | |||||
| 40 | B | A | C | B | |||||
| 41 | B | A | C | C | |||||
| 42 | B | B | A | A | |||||
| 43 | B | B | A | B | |||||
| 44 | B | B | A | C | |||||
| 45 | B | B | B | A | |||||
| 46 | B | B | B | B | |||||
| 47 | B | B | B | C | |||||
| 48 | B | B | C | A | |||||
| 49 | B | B | C | B | |||||
| 50 | B | B | C | C | |||||
| 51 | B | C | A | A | |||||
| 52 | B | C | A | B | |||||
| 53 | B | C | A | C | |||||
| 54 | B | C | B | A | |||||
| 55 | B | C | B | B | |||||
| 56 | B | C | B | C | |||||
| 57 | B | C | C | A | |||||
| 58 | B | C | C | B | |||||
| 59 | B | C | C | C | |||||
| 60 | C | A | A | A | |||||
| 61 | C | A | A | B | |||||
| 62 | C | A | A | C | |||||
| 63 | C | A | B | A | |||||
| 64 | C | A | B | B | |||||
| 65 | C | A | B | C | |||||
| 66 | C | A | C | A | |||||
| 67 | C | A | C | B | |||||
| 68 | C | A | C | C | |||||
| 69 | C | B | A | A | |||||
| 70 | C | B | A | B | |||||
| 71 | C | B | A | C | |||||
| 72 | C | B | B | A | |||||
| 73 | C | B | B | B | |||||
| 74 | C | B | B | C | |||||
| 75 | C | B | C | A | |||||
| 76 | C | B | C | B | |||||
| 77 | C | B | C | C | |||||
| 78 | C | C | A | A | |||||
| 79 | C | C | A | B | |||||
| 80 | C | C | A | C | |||||
| 81 | C | C | B | A | |||||
| 82 | C | C | B | B | |||||
| 83 | C | C | B | C | |||||
| 84 | C | C | C | A | |||||
| 85 | C | C | C | B | |||||
| 86 | C | C | C | C | |||||
| 87 | |||||||||
| 88 | |||||||||
| 89 |
VBA Code:
'https://www.mrexcel.com/board/threads/combination-help.277924/page-5#post-1424848
'Combination Help
Option Explicit
'bComb=True, bRepet=False - Combinations without repetition
'bComb=True, bRepet=True - Combinations with repetition
'bComb=False, bRepet=False - Permutations without repetition
'bComb=False, bRepet=True - Permutations without repetition
'-------------------------------------------------------------------------------------------------
'http://www.mrexcel.com/forum/excel-questions/277924-combination-help.html
' 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, MaxRow 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
Range("D6:IV65536").ClearContents
MaxRow = 65000 'Set Last Row Number For Combination/Permutation To Be Written
' 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 <= MaxRow Then
Range("D6").Resize(lTotal, p).Value = vResultAll 'you may adjust for other location
Else
While iGroup * MaxRow < lTotal
lMax = lTotal - iGroup * MaxRow
If lMax > MaxRow Then lMax = MaxRow
ReDim vResultPart(1 To lMax, 1 To p)
For l = 1 To lMax
For k = 1 To p
vResultPart(l, k) = vResultAll(l + iGroup * MaxRow, k)
Next k
Next
Range("D6").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 SubThank you all.
I am using Excel 2000
Regards,
Moti
