VBA Code: Multiple Combinations

[AD_Taylor]

Hi,

Has anybody got a VBA Macro that will take a number of items and combine them in various different ways and show all possible combinations?

For example, if I put 4 numbers, (1 into each A1, B1, C1 and D1) the macro should figure out all the possible ways of combining those numbers in a different order. Lets say:

A1 = 1
B1 = 2
C1 = 3
D1 = 4

Then the output would be something like

1234
1243
1324
1342
1423
1432
2134
2143
etc. until all possible solutions are found.

It would be great if the macro could output the combinations in line with the columns the items were in and then have a separate concatentation column that combines them at the end.

Also it should be able to work for any number of items specified (For my purposes I'll only be going up to about 10 max).

I should probably point out that the 'items' being combined can be strings or numbers (should always be integers).

Oh and if it could show the number of combinations found in a separate cell that would be perfect

Appreciate any help with this I know its a big ask to have somebody produce this for me!
~Adam

 

[AlphaFrog]

For my purposes I'll only be going up to about 10 max

Ten values will yield 3,628,800 permutations.

=PERMUT(10,10)

Link: Excel VBA Permutation Macro Code

 

[AD_Taylor]

Ten values will yield 3,628,800 permutations.

=PERMUT(10,10)

Link: Excel VBA Permutation Macro Code

Ok thats a huge amount of permutations! I think I may need to scale this down a bit

Definitely need to go up to 5 values so I'll go with that. Apparently 120 permutations there so a much more manageable number.

I wasn't able to copy and paste the code from the page you linked (link in the YouTube video had broken) so I tried searching for their site and stumbled across this thread on this very forum:

http://www.mrexcel.com/forum/showthread.php?t=435865

Post #8 on this gives a very useful set of code called Sub PowerSetRept() which creates a list of all the possible combinations inlcuding using the same element twice.

Think this is solved now - I seem to have what I want

Thanks for your help,
Adam

 

[AD_Taylor]

Actually... the code I have needs a slight change I think.

This is what I have:

Option Explicit
 
' PGC Oct 2007
' Calculates a Power Set
' Set in A1, down. Result in C1, down and accross. Clears C:Z.
Sub PowerSet()
Dim vElements As Variant, vresult As Variant
Dim lRow As Long, i As Long
 
vElements = Application.Transpose(Range("A1", Range("A1").End(xlDown)))
Columns("C:Z").Clear
 
lRow = 1
For i = 1 To UBound(vElements)
    ReDim vresult(1 To i)
    Call CombinationsNP(vElements, i, vresult, lRow, 1, 1)
Next i
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Long
 
For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
        lRow = lRow + 1
        Range("C" & lRow).Resize(, p) = vresult
    Else
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i
End Sub

At the moment this works well but it only produces unique combinations.

Say I enter PG, DR, BE, CD in Column A. For the 2 part combinations I get:

PG, DR
PG, BE
PG, CD
DR, BE
DR, CD
BE, CD

I'd also like these reversed as well so:

DR, PG
BE, PG
CD, PG etc.

Plus the same for the 3 part and 4 part combinations so that I end up with all possible combinations where each value is only used once in that combination. Basically the order the items come out in matters.

Hopefully this makes sense?

 

[AlphaFrog]

Option Explicit

' PGC Oct 2007
' Calculates a Power Set
' Set in A1, down. Result in C1, down and accross. Clears C:Z.
Sub PowerSet()
    Dim vElements As Variant, vresult As Variant
    Dim lRow As Long, i As Long

    vElements = Application.Transpose(Range("A1", Range("A1").End(xlDown)))
    Columns("C:Z").Clear

    lRow = 0
    For i = 1 To UBound(vElements)
        ReDim vresult(1 To i)
        Call PermutationsNP(vElements, i, vresult, lRow, 1, 1, "")
        'Call CombinationsNP(vElements, i, vresult, lRow, 1, 1)
    Next i
End Sub
 
Sub PermutationsNP(vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer, ByVal strExclude As String)
    'Excludes duplicates within each permutation
    Dim i As Long

    For i = 1 To UBound(vElements)
        If InStr(strExclude, i & ",") = 0 Then
            vresult(iIndex) = vElements(i)
            If iIndex = p Then
                lRow = lRow + 1
                Range("C" & lRow).Resize(, p) = vresult
            Else
                Call PermutationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1, strExclude & i & ",")
            End If
        End If
    Next i
    
End Sub

Sub CombinationsNP(vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
    Dim i      As Long

    For i = iElement To UBound(vElements)
        vresult(iIndex) = vElements(i)
        If iIndex = p Then
            lRow = lRow + 1
            Range("C" & lRow).Resize(, p) = vresult
        Else
            Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
        End If
    Next i
End Sub

 

[AD_Taylor]

Amazing! Thanks for your help with this AlphaFrog - definitely all sorted now