Unique Combinations in an array using VBA - vba

Question

I need a code that could give me a list of unique combinations from a set of elements in an array, something like this:
Say myArray contains [A B C]
So, the output must be:
A
B
C
A B
A C
B C
A B C
or
A B C
B C
A C
A B
A
B
C
either output is OK for me (Starts with 1 combination, followed by 2 combinations and ends with all combination OR vice versa).
The position of the letters are not critical and the order of letters within the same combination type is also not critical.
I'd found a suggestion by 'Dick Kusleika' in a thread: Creating a list of all possible unique combinations from an array (using VBA) but when I tried, it did not present me with the arrangement that I wanted.
I'd also found a suggestion by 'pgc01' in a thread: http://www.mrexcel.com/forum/excel-questions/435865-excel-visual-basic-applications-combinations-permutations.html and it gave me the arrangement that I wanted however, the combinations was not being populated in an array but it was being populated in excel cells instead, using looping for each combination.
So, I wanted the arrangement of combinations to be like what 'pgc01' suggested and being populated in an array as what 'Dick Kusleika' presented.
Anyone can help? Appreciate it.

Answer 1

Start from here:
Sub TestRoutine()
Dim inputt() As String, i As Long
Dim outputt As Variant
inputt = Split("A B C", " ")
outputt = Split(ListSubsets(inputt), vbCrLf)
For i = LBound(outputt) + 2 To UBound(outputt)
MsgBox i & vbTab & outputt(i)
Next i
End Sub
Function ListSubsets(Items As Variant) As String
Dim CodeVector() As Long
Dim i As Long
Dim lower As Long, upper As Long
Dim SubList As String
Dim NewSub As String
Dim done As Boolean
Dim OddStep As Boolean
OddStep = True
lower = LBound(Items)
upper = UBound(Items)
ReDim CodeVector(lower To upper) 'it starts all 0
Do Until done
'Add a new subset according to current contents
'of CodeVector
NewSub = ""
For i = lower To upper
If CodeVector(i) = 1 Then
If NewSub = "" Then
NewSub = Items(i)
Else
NewSub = NewSub & " " & Items(i)
End If
End If
Next i
If NewSub = "" Then NewSub = "{}" 'empty set
SubList = SubList & vbCrLf & NewSub
'now update code vector
If OddStep Then
'just flip first bit
CodeVector(lower) = 1 - CodeVector(lower)
Else
'first locate first 1
i = lower
Do While CodeVector(i) <> 1
i = i + 1
Loop
'done if i = upper:
If i = upper Then
done = True
Else
'if not done then flip the *next* bit:
i = i + 1
CodeVector(i) = 1 - CodeVector(i)
End If
End If
OddStep = Not OddStep 'toggles between even and odd steps
Loop
ListSubsets = SubList
End Function
Note we discard the first two elements of the output array.