Creating all possible combinations from multiple sets - vba

Question

I've limited knowledge in maths so pardon the terms if i'm mistaken.
I need to create all possible combinations from multiple sets with at least 1 item included from that set.
- SetA: [1, 2, 3, 4, 5, 6, 7]
- SetB: [a, b, c, d]
- SetC: [!, #, #, $, %]
Example Output:
- [1,a,!]
- [1,2,a,c,#]
- [1,2,3,4,5,6,7,a,b,c,d,!,#,#,$,%]
Is there a specific combination formula for this since i can only come up with nested loops and i'm not sure if it is even correct.

Answer 1

#barrycarter had good idea of obtaining the power set. However, we don't need to reject anything as we are not getting the power set of the union of sets (this would end up being inefficient as there will be many rejects as the number of sets grows). We simply get the power set of each set, then get all combinations of those power sets. The subroutine below, works for an arbitrary number sets of arbitrary length.
Sub CreateAllCombs()
Dim ArrayOfPowSets() As Variant, mySet() As Variant, ArrCounter() As Long, myPS As Variant
Dim myCombs() As Variant, nextComb() As Variant, ParentComb() As Variant, ArrMax() As Long
Dim i As Long, j As Long, k As Long, count1 As Long, count2 As Long, CombExist As Boolean
Dim tempCol As Long, myMax As Long, maxRow As Long, totalCombs As Long
With ActiveSheet
maxRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With
ReDim ArrayOfSets(1 To maxRow, 1 To 1)
ReDim ArrCounter(1 To maxRow)
ReDim ArrMax(1 To maxRow)
myMax = 0
For i = 1 To maxRow
With ActiveSheet
tempCol = .Cells(i, .Columns.count).End(xlToLeft).Column
End With
ReDim mySet(1 To tempCol)
For j = 1 To tempCol: mySet(j) = Cells(i, j): Next j
myPS = PowerSet(mySet)
ArrMax(i) = UBound(myPS)
If ArrMax(i) > myMax Then
myMax = ArrMax(i)
ReDim Preserve ArrayOfPowSets(1 To maxRow, 1 To ArrMax(i))
End If
For j = 1 To ArrMax(i)
ArrayOfPowSets(i, j) = myPS(j)
Next j
ArrCounter(i) = 1
Next i
CombExist = True
totalCombs = 0
Do While CombExist
count1 = 1
ReDim ParentComb(1 To 1)
For i = 1 To maxRow - 1
For j = 1 To UBound(ArrayOfPowSets(i, ArrCounter(i)))
ReDim Preserve ParentComb(1 To count1)
ParentComb(count1) = ArrayOfPowSets(i, ArrCounter(i))(j)
count1 = count1 + 1
Next j
Next i
For i = 1 To ArrMax(maxRow)
count2 = count1
nextComb = ParentComb
For j = 1 To UBound(ArrayOfPowSets(maxRow, i))
ReDim Preserve nextComb(1 To count2)
nextComb(count2) = ArrayOfPowSets(maxRow, i)(j)
count2 = count2 + 1
Next j
totalCombs = totalCombs + 1
ReDim Preserve myCombs(1 To totalCombs)
myCombs(totalCombs) = nextComb
Next i
k = maxRow - 1
Do While (ArrCounter(k) >= ArrMax(k))
ArrCounter(k) = 1
k = k - 1
If k = 0 Then Exit Do
Loop
If k > 0 Then ArrCounter(k) = ArrCounter(k) + 1 Else CombExist = False
Loop
Sheets("Sheet2").Select
For i = 1 To totalCombs
For j = 1 To UBound(myCombs(i))
Cells(i, j) = myCombs(i)(j)
Next j
Next i
End Sub
I used a slightly modified version of the power set function written by John Coleman found here
Function PowerSet(Items As Variant) As Variant
Dim PS As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim subset() As Variant
n = UBound(Items)
ReDim PS(1 To 1 + 2 ^ n - 2)
For i = 1 To 2 ^ n - 1
ReDim subset(1 To n)
k = 0
For j = 0 To n - 1
If i And 2 ^ j Then
k = k + 1
subset(k) = Items(j + 1)
End If
Next j
ReDim Preserve subset(1 To k)
PS(i) = subset
Next i
PowerSet = PS
End Function
This assumes that SetA is on row 1, SetB is on row 2, etc. Observe:
Additionally, the reader should be warned that this may take a while as there is over 14 million possible combinations.
(2^3 - 1) * (2^5 - 1) * (2^16 - 1) = 7 * 31 * 65535 = 14221095
Also, all combinations are written out generically to Sheet2.

Answer 2

I think i found my solution please verify.
First, for each sets, i created all possible combinations and checked the length using the sum of pascal triangle without the null or this formula:
n!/(r!(n-r)!) - 1
e.g.
SetB: [a, b, c, d] -> [a,b,c,d,ab,ac,ad,bc,bd,cd,abc,abd,acd,bcd,abcd]
After creating all possible combinations for each sets, I just used product rule
[SetA] X [SetB] X [SetC]
Which resulted for all possible combinations for:
multiple items
multiple sets
no repeat
no order
Reference: https://www.mathsisfun.com/combinatorics/combinations-permutations-calculator.html
EDIT1: checking for amount of combinations per set can also be (2^n)-1 where n= length of set

Answer 3

Have you tried using nested for loops.
Sub Hello()
MsgBox ("Hello, world!")
Dim arr1
arr1 = Array("1", "2", "3")
Dim arr2
arr2 = Array("a", "b", "c")
Dim arr3
arr3 = Array("!", "#", "$")
For i = 0 To UBound(arr1)
For j = 0 To UBound(arr2)
For k = 0 To UBound(arr3)
MsgBox (arr1(i) & arr2(j) & arr3(k))
Next
Next
Next
End Sub