VBA – Compute All Combinations of a Given Set

Yesterday I received an email, refering to some 2 old articles in VitoshAcademy for nested loops without recursion:

• VBA – Nested loops with recursion (Permutations) 
• VBA – Avoid nested loops with recursion (Part 2)

As far as the person from the email was taking a look at the code and was struggling, wanting to perform the combinations of the set [1,2,3,4,5,6] with 4 samples, I thought it would be interesting, if I give it a try, rewriting the old code I was using almost 5 years ago.

It was fun to see how I was thinking about programming back then and that I actually have changed slightly after. Anyway, while rewriting the code I noticed, that there are 2 main differences between permutations and combinations:

• In combinations there are no values repeated;
• In combinations every value is bigger than the previous one;

The latter is actually not true in general, but if we follow this rule, we are forced to skip adding “1243” after having already written “1234”. So, it is a kind of logic I decided to use, as far as sorting and implementing to a set was requiring more words to explain.

Long story short, implementing the old code I wrote 5 years ago, I have added 2 new conditions:

If Not AnyValueBiggerThanNext(arr) And Not AnyValueIsRepeated(arr) Then
    PrintArrayOnSingleLine arr

And it actually brought me to the desired result:

And this is the code, which probably looks better than the one I have written in 2015:

Sub Main()
    
    Dim size As Long: size = 4
    Dim initialArray As Variant: initialArray = Array(1, 2, 3, 4, 5, 6)
    Dim arr As Variant: ReDim arr(size - 1)
    Dim n As Long: n = UBound(arr) + 1
    
    EmbeddedLoops 0, size, initialArray, n, arr
    
End Sub

Function EmbeddedLoops(index As Long, size As Long, initialArray As Variant, n As Long, arr As Variant)
    
    Dim p As Variant
    
    If index >= size Then
        If Not AnyValueBiggerThanNext(arr) And Not AnyValueIsRepeated(arr) Then
            PrintArrayOnSingleLine arr
        End If
    Else
        For Each p In initialArray
            arr(index) = p
            EmbeddedLoops index + 1, size, initialArray, n, arr
        Next p
    End If
    
End Function

Public Function AnyValueBiggerThanNext(arr As Variant) As Boolean

    Dim i As Long
    For i = LBound(arr) To UBound(arr) - 1
        If arr(i) > arr(i + 1) Then
            AnyValueBiggerThanNext = True
            Exit Function
        End If
    Next i
    
    AnyValueBiggerThanNext = False

End Function

Public Function AnyValueIsRepeated(arr As Variant) As Boolean
            
    On Error GoTo AnyValueIsRepeated_Error:
    
    Dim element As Variant
    Dim testCollection As New Collection
    
    For Each element In arr
        testCollection.Add "item", CStr(element)
    Next element
    
    AnyValueIsRepeated = False
    
    On Error GoTo 0
    Exit Function
    
AnyValueIsRepeated_Error:
    AnyValueIsRepeated = True
    
End Function

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim i As Long
    Dim textArray As String
    
    For i = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(i)
    Next i
    
    Debug.Print textArray
    
End Sub

Actually, there are plenty of faster ways to make it happen, but my idea was to rewrite the old code with some new conditions. A quick good look for the faster ways – https://stackoverflow.com/questions/127704/algorithm-to-return-all-combinations-of-k-elements-from-n

Hope you are enjoying it. 🙂