Hi there,
I`m looking to get a unique combinations generator macro adjusted, not sure if it is possible. The original macro request was already beyond me so there`s no chance in hell I`ll manage this.
The Macro created in the linked thread (i attached the excel file w/ macro) delivers all unique combinations of a list`s elements.
So from the below list of 5 elements
It will deliver combinations which are unique. By unique I mean if it delivers combination 1 & 5 it will NOT deliver 5 & 1.
The combinations can consist of between 2 & 6 numbers (e.g. it delivers 111112 [but NOT 111121, 11211, 12111 & 21111]).
Would it be possible to give the macro functionality to do combinations of each group (picture 1) & then output combinations between those groups (picture 2)? This will save me from going through like 1000s of records to manually remove ones I cannot use (like 111112, 111333). If it is not possible is there some simpler way i can go about getting a similar outcome?
Picture 1
Picture 2
This is the code which gives me the unique combinations & here is the file Box (credit goes to user StephenCrump for it)
I`m looking to get a unique combinations generator macro adjusted, not sure if it is possible. The original macro request was already beyond me so there`s no chance in hell I`ll manage this.
The Macro created in the linked thread (i attached the excel file w/ macro) delivers all unique combinations of a list`s elements.
So from the below list of 5 elements
It will deliver combinations which are unique. By unique I mean if it delivers combination 1 & 5 it will NOT deliver 5 & 1.
The combinations can consist of between 2 & 6 numbers (e.g. it delivers 111112 [but NOT 111121, 11211, 12111 & 21111]).
Would it be possible to give the macro functionality to do combinations of each group (picture 1) & then output combinations between those groups (picture 2)? This will save me from going through like 1000s of records to manually remove ones I cannot use (like 111112, 111333). If it is not possible is there some simpler way i can go about getting a similar outcome?
Picture 1
Picture 2
This is the code which gives me the unique combinations & here is the file Box (credit goes to user StephenCrump for it)
VBA Code:
' PGC Set 2007
' Calculates and writes the Combinations / Permutations with/without repetition
' 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 DoIt()
Dim vElements As Variant, vResult As Variant, vResultAll As Variant
Dim lrow As Long, lTotal As Long, p As Long, pMax As Long, i As Long, NoRows As Long
Dim bComb As Boolean, bRepet As Boolean
Dim rng As Range
p = 5 'Number of elements in combination
pMax = 5 'Careful! The code clears this many columns, i.e. C,E,G,I,K,M for pMax=6
bComb = True
bRepet = True
With Worksheets("Chosen List")
Set rng = .Range("A" & .Range("StartRow").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
vElements = Application.Index(Application.Transpose(rng), 1, 0)
With Application
If bComb Then
lTotal = .Combin(UBound(vElements) + IIf(bRepet, p - 1, 0), p)
Else
If bRepet = False Then lTotal = .Permut(UBound(vElements), p) Else lTotal = UBound(vElements) ^ p
End If
End With
ReDim vResult(1 To p)
ReDim vResultAll(1 To lTotal, 1 To p)
Call CombPermNP(vElements, p, True, True, vResult, lrow, vResultAll, 1, 1)
With Worksheets("Daily Meal Macro").Range("StartRow")
NoRows = .End(xlDown).Row - .Row + 1
For i = 0 To p - 1
With .Offset(, 2 * i)
.Resize(NoRows).ClearContents
.Resize(lTotal).Value = Application.Index(vResultAll, , i + 1)
End With
Next i
For i = p To pMax - 1
.Offset(, 2 * i).Resize(NoRows).ClearContents
Next i
End With
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
