# Excel VBA Combinations/Permutations

This is a discussion on Excel VBA Combinations/Permutations within the Excel Questions forums, part of the Question Forums category; Hi Guys, I'm really struggling to get the answer to the following question and hope you can help. I have ...

1. ## Excel VBA Combinations/Permutations

Hi Guys,

I'm really struggling to get the answer to the following question and hope you can help.

I have a list with items 1, 2 and 3.

How can I create a list that gives the following results: 1, 2, 3, 12, 13, 23 & 123

I know I can just use 3 For loops but I want the code to be able to cope with x numbers in the list. For example 1, 2, 3, 4 and 5 or 1, 2, 3, 4, 5, 6, 7, 8 and 9

Any help would be greatly appreciated

2. ## Re: Excel VBA Combinations/Permutations

Hi Andrew
Welcome to the board

You want to calculate the Power Set of a Set.

You can try this code:

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```
Test:

- Write a, b, c, d in A1:A4
- run PowerSet

ABCDEFG
1a
2ba
3cb
4dc
5d
6ab
7ac
9bc
10bd
11cd
12abc
13abd
14acd
15bcd
16abcd
17
[Book1]Sheet1

3. ## Re: Excel VBA Combinations/Permutations

Exactly what i was looking for!!

Thanks very much pgc01

4. ## Re: Excel VBA Combinations/Permutations

Hello,

I'm looking for the same thing except for permutations...ie order does matter so for 3 #'s or letters I will get 3^1 + 3^2 + 3^3 answers, or 39. But just like his original question, I don't know how many I'll have to start with.

Thanks!

5. ## Re: Excel VBA Combinations/Permutations

Originally Posted by mountainclimber11
Hello,

I'm looking for the same thing except for permutations...ie order does matter so for 3 #'s or letters I will get 3^1 + 3^2 + 3^3 answers, or 39. But just like his original question, I don't know how many I'll have to start with.
Hi mountainclimber11

n + n^2 + n^3 + ... + n^n

This is a geometric progression, the total is:

n * (n^n - 1) / (n - 1)

In the case of 3 elements the total is:

3 * (3^3 - 1) / (3 - 1) = 3 * 26 / 2 = 39

The code is similar to the PowerSet but simpler as now you simply loop through all the values.

Insert in a module and run:

Code:
```Option Explicit

' PGC Dez 2009
' Permutations of N elements taken 1 to p at a time
' Set in A1, down. Result in C1, down and accross. Clears C:Z.
Sub PermutationsN_1ToP_R()
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

For i = 1 To UBound(vElements)
ReDim vresult(1 To i)
Call PermutationsNPR(vElements, i, vresult, lRow, 1)
Next i
End Sub

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

For i = 1 To UBound(vElements)
vresult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
Range("C" & lRow).Resize(, p) = vresult
Else
Call PermutationsNPR(vElements, p, vresult, lRow, iIndex + 1)
End If
Next i
End Sub```
Ex, for 3 elements:

ABCDEF
1a a
2b b
3c c
4  aa
5  ab
6  ac
7  ba
8  bb
9  bc
10  ca
11  cb
12  cc
13  aaa
14  aab
15  aac
16  aba
17  abb
18  abc
19  aca
20  acb
21  acc
22  baa
23  bab
24  bac
25  bba
26  bbb
27  bbc
28  bca
29  bcb
30  bcc
31  caa
32  cab
33  cac
34  cba
35  cbb
36  cbc
37  cca
38  ccb
39  ccc
40
[Book2]Sheet6

6. ## Re: Excel VBA Combinations/Permutations

Hey, thanks! My fault, I should have said 33 not 39 or 15 sets because I don't want the lines that have all the same letter (aaa, bb, cc, etc.), but your posted answers my question. This is what I ended up using:

Code:
```Sub comboze()
Dim z, y() As String, u As Integer, v As Integer
Dim a As Integer, b As Long, c As Integer, d As Integer
Dim w(), g, ct, i, j, kk
z = Array("a", "b", "c")
u = UBound(z) + 1
v = u
ReDim y(1 To u ^ v, 1 To v), w(1 To u ^ v, 1 To v)
For a = 1 To v
For b = 1 To u ^ v Step u ^ a
For c = b To b + u ^ (a - 1) - 1
For d = 1 To u
y(c + u ^ (a - 1) * (d - 1), v - a + 1) = z(d - 1)
Next d, c, b, a
n = u ^ v: m = v
With CreateObject("Scripting.Dictionary")
For i = 1 To n
For j = 1 To m
.Item(y(i, j)) = .Item(y(i, j)) + 1
Next j
kk = .keys
For a = 1 To .Count
w(i, a) = kk(a - 1)
Next a
.removeall
Next i
For i = 1 To n
g = Empty
For j = 1 To m: g = g & Chr(30) & w(i, j): Next j
If Not .exists(g) Then
ct = ct + 1
For j = 1 To m: w(ct, j) = w(i, j): Next j
End If
Next i
End With
Range("A1").Resize(ct, m) = w
End S```

http://www.mrexcel.com/forum/showthr...44#post2164844

Thanks!

7. ## Re: Excel VBA Combinations/Permutations

Hi All,

This method "PowerSet" to work the combinations out is certainly really impressive!

Is it possible to get the PowerSet Code adjusted so it also considers its own velements?.

I mean, when running the code based on 'A' and 'B' and 'C'

It will return:
A
B
C
A B
A C
B C
A B C

I need it to return:

A
B
C
A A
A B
A C
B B
B C
C C
A A A
A A B
A A C
A B B
A B C
A C C
B B B
B B C
B C C
C C C

At the moment I can get the desired result by writing each elements 3 times, ie:

A
A
A
B
B
B
C
C
C

Once I have the results (by running the powerset code), I remove all the duplicate rows from the results (using excel 'remove duplicate').

The method works fine until I start increasing the number of letters, simply because excel will not handle so much data. The must be a way to do this without duplicating the elements then removing duplicates.

Thanks

8. ## Re: Excel VBA Combinations/Permutations

Hi
Welcome to the board

With the set of elements in A1, down, try:

Code:
```Sub PowerSetRept()
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 Long, iIndex As Long)
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, iIndex + 1)
End If
Next i
End Sub```

ABCDEF
1a
2b a
3c b
4  c
5  aa
6  ab
7  ac
8  bb
9  bc
10  cc
11  aaa
12  aab
13  aac
14  abb
15  abc
16  acc
17  bbb
18  bbc
19  bcc
20  ccc
21
[Book1]Sheet2

9. ## Re: Excel VBA Combinations/Permutations

Thanks.

This is exactly what I was after!

Thank you ever so much for doing this =)

10. ## Re: Excel VBA Combinations/Permutations

Hi Again...

What would be the formula to work out the results of CombRept based on given no of elements?

Say I have 2 elements, I need to know (before I run CombRept):
how many rows of data will contain 1 element (=2),
how many rows of data will contain 2 elements (=3).

Say I have 4 elements, I need to know (before I run CombRept):
how many rows of data will contain 1 elements(=4),
how many rows of data will contain 2 elements(=10)
how many rows of data will contain 3 elements (=20)
how many rows of data will contain 4 elements (=35)

The build-in COMBIN does really tell the that.

Thanks!

Page 1 of 2 12 Last

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•