VBA Code: Multiple Combinations

AD_Taylor

AD_Taylor

Well-known Member
Joined
May 19, 2011
Messages
687
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
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Sort by date Sort by votes
AlphaFrog said:
Ten values will yield 3,628,800 permutations.

=PERMUT(10,10)

Link: Excel VBA Permutation Macro Code
Click to expand...

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
 
Upvote 0
Actually... the code I have needs a slight change I think.

This is what I have:

Code: 
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?
 
Upvote 0
Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Lottery Combinations Filter
Replies
2
Views
544
Fluff
Fluff
S
  • Question
Excel Xlookup + Filter Combination
Replies
2
Views
2K
RudRud
R
D
  • Question
Issue making macro or formula on my spreedsheet
Replies
2
Views
79
devan69
D
C
  • Question
Running Data Refresh Macro, then Table Update Macro, Back-to-Back?
2
Replies
11
Views
588
Alex Blakenburg
A
P
  • Solved
single-formula combining of multiple dynamic arrays (VSTACK?)
Replies
4
Views
825
Plod518
P

Forum statistics

Threads
1,215,038
Messages
6,122,798
Members
449,095
Latest member
m_smith_solihull

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top