# CODE FOR PERMUTATIONS & COMBINATIONS

Any valid code for Excel 2010 available for:

1. Listing all the possible Permutations & Combinations;
2. Of relevant/selected cells;
3. FROM a specific minimum size of items;
4. TO a maximum size of items?

For example:
With the data being simply five cells as:
A B C D E

Minimum Size being:
2

Maximum Size being
3

Result of PERMUTATIONS resulting to be:

A B
A C
A D
A E
B A
B C
B D
B E
C A
C B
C D
C E
D A
D B
D C
D E
E A
E B
E C
E D
A B C
A B D
A B E
A C B
A C D
A C E
A D B
A D C
A D E
A E B
A E C
A E D
B A C
B A D
B A E
B C A
B C D
B C E
B D A
B D C
B D E
B E A
B E C
B E D
C A B
C A D
C A E
C B A
C B D
C B E
C D A
C D B
C D E
C E A
C E B
C E D
D A B
D A C
D A E
D B A
D B C
D B E
D C A
D C B
D C E
D E A
D E B
D E C
E A B
E A C
E A D
E B A
E B C
E B D
E C A
E C B
E C D
E D A
E D B
E D C

And,

Result of COMBINATIONS resulting to be:

A B
A C
A D
A E
B C
B D
B E
C D
C E
D E
A B C
A B D
A B E
A C D
A C E
A D E
B C D
B C E
B D E
C D E

Hi,

The code below was written by Myrna Larson and it does what you want but not in a single pass. paste the lot into a general midule and then on the worksheet enter the following

A1= C
A2 = 2
A3= A

A4=B

ETC

Carry on filling down from A3 as far as you need.

Now IMPORTANT select A1 and run the code. In this case it will add a new sheet with the combinations of 2 from n

Change A1 to P and you get permutations and change A2 to change the number to combine/permutate

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
'  Posted by Myrna Larson
'  July 25, 2000
'  Microsoft.Public.Excel.Misc
'  Subject:  Combin

Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If
PopSize = Rng.Cells.CountLarge - 2
If PopSize < 2 Then GoTo DataError
SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError
Which = UCase\$(Rng.Cells(1).Value)
Select Case Which
Case "C"
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If N > Cells.CountLarge Then GoTo DataError
Application.ScreenUpdating = False
Set Results = Worksheets.Add
vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0
If Which = "C" Then
Else
End If
vAllItems = 0
Application.ScreenUpdating = True
Exit Sub
DataError:
If N = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells. " _
& String\$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the number " _
& "of items in a subset, the cells below are the values from which " _
& "the subset is to be chosen."
Else
Which = "This requires " & Format\$(N, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)
Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer
If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If
For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i
If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If
Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)
Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer
If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If
For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i
If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If
Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)
Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long
If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1
If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If
Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If
BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If
End If
'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i
'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid\$(sValue, 3)
End Sub  'SavePermutation

Mike H

·

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

OK!!!
So it was A1 that I had not been selecting!
Thanx for the excellent clarification buddy!

Hi,

Your welcome and thanks for the feedback

Also most versions of this code you will find on the web will fail with an overflow error in E2007 and E2010.

It was originally written for versions of Excel prior to E2007 and in those versions the lines (2 of them)

If N > Cells.Count Then GoTo DataError

are fine because there are less than  2147483647 cells on a worksheet in those versions of Excel

In E2007 and later the VB statement COUNTLARGE was added and the 2 lines in the code need to be changed as below to handle the 17179869184 cells on those worksheets

If N > Cells.CountLarge Then GoTo DataError

In the code I posted I simply changed those lines but to do it properly then you should do something along the lines of this pseudo code.

If application.version >= excel 2007 then

use countlarge

else

use count

end if

Mike H

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

## Question Info

Last updated September 9, 2019 Views 6,055 Applies to: