# Thread: find all combinations (no repeats)

1. ## find all combinations (no repeats)

I'm trying to figure out a way to list all possible combinations (no repeats) of any list of items (I'm using numbers for now to make it simpler). Anything beyond 16 items would be too many rows for Excel to display. 16 items = (2^16)-1 = 65535 possible combinations (rows)

By no repeats, i mean: 1,2,3 and 2,3,1 would be the same item combination (not 2 different ones).

Anyway, I've attached the file as it is so far, but I'm missing the part where it actually outputs the subsets, like sets of 2, sets of 3, etc. I would like the output to start in F1 and go down.

I have searched this site and google all day with very little promising results. There's a ton of samples, but none of them showed a general formula or code that would handle this type of thing.

Can anyone walk me through this? This is not homework. I'm doing this as a curious experiment because I had the need to show all possible combinations (by using different colored dots on a map) at work and had to do it in my head. I knew there had to be an easier way.

If there's a solution via formulas instead of VBA I would like to see how that would work too. Also, my mapping program allows me to query things with SQL. If any SQL expert out there knows of a way to do this automatically via SQL, that'd be awesome too. Thanks,
Tom  Reply With Quote

2. Anything beyond 16 items would be too many rows for Excel to display. 16 items = (2^16)-1 = 65535 possible combinations (rows)
The number of combanations of 18 items, taken 9 at a time

C(18,9) = 48,620

C(19,9) = 92,378

so you could get a few more and not exceed the 2003 row limit

But I'm not sure what you want running down the rows?

For ex for C(4,2) = 6, were you looking for something like

1,2
1,3
1,4
2,3
2,4
3,4

Paul  Reply With Quote

3. Yes, but i want to do that for all sets, not just combinations of 9 at a time.

For instance, say I have a set of 3 numbers: (1,2,3)
Sets of 1 number each = 3 possibles
Sets of 2 numbers each = 3 possibles
Sets of 3 numbers each = 1 possible

Added up that would be 7 possibles but i want to show them all, either with commas like you have above, or each number in its own cell, going down however many rows it would take (in this case 7 rows). I hope that makes sense?   Reply With Quote

4. Yes, but i want to do that for all sets, not just combinations of 9 at a time.
Yes, I meant that it seems like you can do up to 18 and not 16 before you run out of rows

I did a prelim last night very small amount of data with max = 4

So I came up with 4 columns the way I was playing around (for N = 4)

C(4,1)__C(4,2)___C(4,3)___C(4,4)
1______1,2_______1,2,3___1,2,3,4
2______1,3_______1,2,4
3 _____1,4_______1,3,4
4 _____2,3_______2,3,4
_______2,4
_______3,4

I set it up so that I could just input N and it will (eventually) generate the N columns and the 'whole bunch of' rows (that's a technical Excel term )

It's an interesting problem

Paul  Reply With Quote

5. Oh! I was putting them all in 1 column. I didn't think to put the sets in different columns like you did. I guess that's why I came up with the limit at 16.

I'd appreciate if you could walk me through how you did it, or show the code. Thanks!  Reply With Quote

6. sorry, image didn't come through. here it is.  Reply With Quote

7. Hi Tom,

Have you looked at Tushar Mehta's work?

http://www.tushar-mehta.com/excel/tips/powerset.html

Very quickly put together, and early bound, but using several of his functions from the above link... Does this help at all?

```Option Explicit

Sub exa()
Dim FSO As FileSystemObject
Dim FIL As TextStream

Dim a, b
Dim i As Long, n As Long

Set FSO = New FileSystemObject
Set FIL = FSO.CreateTextFile(ThisWorkbook.Path & "\Test.txt")

a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17)

For i = LBound(a) To UBound(a)
b = createCombinations(a, i + 1, ",")
For n = LBound(b) To UBound(b)
FIL.WriteLine b(n)
Next
Next
FIL.Close
End Sub

Public Function createCombinations(Arr, NbrItems As Integer, Delim As String)
createCombinations = createSubset(Arr, NbrItems, Delim)
End Function

Public Function createSubset(Arr, NbrItems As Integer, Delim As String)
Dim Rslt
ReDim Rslt(0)

aSubset Arr, LBound(Arr), NbrItems, Delim, "", Rslt
ReDim Preserve Rslt(UBound(Rslt) - 1)
'Debug.Assert NbrElements(Rslt) = _
Application.WorksheetFunction.Combin(NbrElements(Arr), NbrItems)
createSubset = Rslt
End Function

Private Sub aSubset(Arr, CurrIdx, NbrItems, ByVal Delim As String, _
ByVal PreString As String, ByRef Rslt)
Dim i As Integer
If NbrItems = 0 Then
If PreString = "" Then Rslt(UBound(Rslt)) = PreString _
Else Rslt(UBound(Rslt)) = Left(PreString, Len(PreString) - Len(Delim))
ReDim Preserve Rslt(UBound(Rslt) + 1)
Else
For i = CurrIdx To NbrElements(Arr) - NbrItems + LBound(Arr)
aSubset Arr, i + 1, NbrItems - 1, Delim, _
PreString & Arr(i) & Delim, Rslt
Next i
End If
End Sub

Private Function NbrElements(Arr) As Integer
On Error Resume Next
NbrElements = UBound(Arr) - LBound(Arr) + 1
End Function```
Mark  Reply With Quote

8. My effort

[vba]
Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim bDone As Boolean

iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub

'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
For i = 1 To iNumber
Next i

'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents

'columns = C(iNumber, iCol)
For iCol = 1 To iNumber

'start in first row of iCol
iRow = 1

ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"

Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i

Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"

Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i

bDone = False

While Not bDone

'do first one

For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i

iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"

If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 1 Then GoTo NextCol
Wend

'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1

For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If

'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend

End Select

NextCol:
Next iCol

End Sub
[/vba]

There's a little more brute force ('inelagance') than I'd like, so maybe some others can offer clean up suggestions

Paul  Reply With Quote

9. I think I must have posted an imternediate version

That does NOT do what I had it doing before

I'll have to track down my working version

That one doesn't finish all the combinations

Paul  Reply With Quote

10. Dumb mistake - I was working in 2010 and made changes to my 2010 .xlsm after I back-saved in it 2003 .xls format

Only difference was changing the test in the j loop

[vba]
Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim bDone As Boolean

iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub

'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
For i = 1 To iNumber
Next i

'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents

'columns = C(iNumber, iCol)
For iCol = 1 To iNumber

'start in first row of iCol
iRow = 1

ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"

Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i

Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"

Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i

bDone = False

While Not bDone

'do first one

For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i

iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"

If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 0 Then GoTo NextCol ' <<<<<<<<<
Wend

'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1

For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If

'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend

End Select

NextCol:
Next iCol

End Sub
[/vba]

Paul  Reply With Quote

11. I thought that there was an other problem that I had found/fixed I figure it'd be easier to just make the VBA change if you're interested

[VBA]
Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = s & aData(i) & "," ' <<<<<<<<<
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"
[/VBA]

Paul  Reply With Quote

12. Good afternoon Paul,

I know this is an old tread, 02-20-2011, 02:41 PM, but I came across it while searching Google.

I have been trying to adapt the code to put the total number of combinations produced for each distribution directly after the last entry for each distribution. I just can't seem to get it quite right though.

This is what I am using for Case 1...

`ActiveSheet.Cells(i + 2, iCol).Value = Application.Count(aData(i))`
...and this is what I am using for Case iNumber...

`ActiveSheet.Cells(3, iCol).Value = Application.CountA(aData(iNumber))`
...any help will be appreciated.  Reply With Quote

13. If I'm understanding, adding these 3 lines towards the end

```NextCol:

With ActiveSheet.Cells(1, iCol).End(xlDown).Offset(1, 0)
.Value = (.Row - 2) & " Comb"
End With

Next iCol
End Sub```  Reply With Quote

14. Spot on Paul, thanks very much.  Reply With Quote

15. ## Hi, I need help regarding listing of all possible combinations without repetitions. Originally Posted by TrippyTom I'm trying to figure out a way to list all possible combinations (no repeats) of any list of items (I'm using numbers for now to make it simpler). Anything beyond 16 items would be too many rows for Excel to display. 16 items = (2^16)-1 = 65535 possible combinations (rows)

By no repeats, i mean: 1,2,3 and 2,3,1 would be the same item combination (not 2 different ones).

Anyway, I've attached the file as it is so far, but I'm missing the part where it actually outputs the subsets, like sets of 2, sets of 3, etc. I would like the output to start in F1 and go down.

I have searched this site and google all day with very little promising results. There's a ton of samples, but none of them showed a general formula or code that would handle this type of thing.

Can anyone walk me through this? This is not homework. I'm doing this as a curious experiment because I had the need to show all possible combinations (by using different colored dots on a map) at work and had to do it in my head. I knew there had to be an easier way.

If there's a solution via formulas instead of VBA I would like to see how that would work too. Also, my mapping program allows me to query things with SQL. If any SQL expert out there knows of a way to do this automatically via SQL, that'd be awesome too. Thanks,
Tom  Reply With Quote

16. ## Hi, I need help regarding listing of all possible combinations without repetitions.

I have ten columns, each column has five rows in them. Each row has one word, I need to list out combinations without repetition using these ten column and 5 rows in each column. One element to be taken from one column at a time. Each combination will have five elements, one from each column. Please help me how to do this.  Reply With Quote

17. I was also looking for a answer to this question. Thanks. Originally Posted by Paul_Hossler Dumb mistake - I was working in 2010 and made changes to my 2010 .xlsm after I back-saved in it 2003 .xls format

Only difference was changing the test in the j loop

[vba]
Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim bDone As Boolean

iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub

'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
For i = 1 To iNumber
Next i

'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents

'columns = C(iNumber, iCol)
For iCol = 1 To iNumber

'start in first row of iCol
iRow = 1

ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"

Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i

Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"

Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i

bDone = False

While Not bDone

'do first one

For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i

iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"

If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 0 Then GoTo NextCol ' <<<<<<<<<
Wend

'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1

For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If

'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend

End Select

NextCol:
Next iCol

End Sub
[/vba]

Paul  Reply With Quote

18. ## Issue with VBA

Hi Paul,
I've tried use the below but for "aData(i) = Array("5L", "5R", "4L", "4R", "3L", "3R", "B2", "B3", "B4")" as this is exactly what I need to find however it's not seems to be working. VBA is new to me so going through trial and error here. Would you be able to point what I'm doing wrong please? Originally Posted by Paul_Hossler My effort

[vba]
Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim bDone As Boolean

iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub

'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
For i = 1 To iNumber
Next i

'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents

'columns = C(iNumber, iCol)
For iCol = 1 To iNumber

'start in first row of iCol
iRow = 1

ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"

Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i

Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"

Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i

bDone = False

While Not bDone

'do first one

For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i

iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"

If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 1 Then GoTo NextCol
Wend

'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1

For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If

'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend

End Select

NextCol:
Next iCol

End Sub
[/vba]

There's a little more brute force ('inelagance') than I'd like, so maybe some others can offer clean up suggestions

Paul  Reply With Quote

19. I didn't go through the macro, but try changing this line

```aData = Array("5L", "5R", "4L", "4R", "3L", "3R", "B2", "B3", "B4")
```
aData(I) = … refers to just one element  Reply With Quote

20. Good day Sir,

Really hoping you could see this soon because this thread is pretty old but this particular response exactly describes what I am trying achieve. I am very new to VBA and have been literally surfing all day on how to achieve generating results of a number of combinations from a list of N items, taking R at a time. Too many confusing codes.

I have got a list of 15 alphabets (A - O) in a column and want to be able to combine 4 at a time.
The number of combinations for this is C(15,4) = 1365

I want the results displayed down the rows just like in your comment. Something like;

A,B,C,D
A,B,J,K
L,M,N,O
C,E,F,H

etc  Reply With Quote