# Combination And Permutation with no repeat

#### Vishaal

##### Active Member

in column "A", i have the numbers, suppose it is 0 to 99

(1) Now i want the list of generated numbers through combination with no repeats in the set of 5, please provide any vba code

(2) I want the list of generated numbers through permutation with no repeats in the set of 5, please provide any vba code

pls provide.

Thanks bro

#### Vishaal

##### Active Member
hi,

i have tried but its showing error

using the following sheet

 Col 1 Col 2 p 10 Combinations FALSE Repetition TRUE Set 0 1 2 3 4 5 6 7 8 9

<colgroup><col><col></colgroup><tbody>
</tbody>

using this code

Option Explicit

' PGC Set 2007
' Calculates and writes the Combinations / Permutations with/without repetition
' Assumes the result is written from row 1 down. If the total number of cells in a column
' is less than tha number of results continues in another group of columns to the right.
' vElements - Array with the set elements (1 to n)
' p - number of elements in 1 combination/permutation
' bComb - True: Combinations, False: Permutations
' bRepet - True: with repetition, False: without repetition
' vResult - Array to hold 1 permutation/combination (1 to p)
' lRow - row number. the next combination/permutation is written in lRow+1
' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
' iElement - order of the element to process in case of combination
' iIndex - position of the next element in the combination/permutation

' Sub CombPerm() deals with the input / output
' Sub CombPermNP() generates the combinations / permutations

Sub CombPerm()
Dim rRng As Range, p As Integer
Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
Dim lRow As Long, bComb As Boolean, bRepet As Boolean
Dim vResultPart, iGroup As Integer, l As Long, lMax As Long, k As Long

' Get the inputs and clear the result range (you may adjust for other locations)
Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked
bComb = Range("B2")
bRepet = Range("B3")
Range("D1", Cells(1, Columns.Count)).EntireColumn.Clear

' Error
If (Not bRepet) And (rRng.Count < p) Then
MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"
Exit Sub
End If

' Set up the arrays for the set elements and the result
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
With Application.WorksheetFunction
If bComb = True Then
lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
Else
If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
End If
End With
ReDim vResult(1 To p)
ReDim vResultAll(1 To lTotal, 1 To p)

' Calculate the Combinations / Permutations
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)

' Write the Combinations / Permutations
' Since writing to the worksheet cell be cell is very slow, uses temporary arrays to write one column at a time
Application.ScreenUpdating = False
If lTotal <= Rows.Count Then
Range("D1").Resize(lTotal, p).Value = vResultAll
Else
While iGroup * Rows.Count < lTotal
lMax = lTotal - iGroup * Rows.Count
If lMax > Rows.Count Then lMax = Rows.Count
ReDim vResultPart(1 To lMax, 1 To p)
For l = 1 To lMax
For k = 1 To p
vResultPart(l, k) = vResultAll(l + iGroup * Rows.Count, k)
Next k
Next
Range("D1").Offset(0, iGroup * (p + 1)).Resize(lMax, p).Value = vResultPart
iGroup = iGroup + 1
Wend
End If
Application.ScreenUpdating = True
End Sub

Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
ByVal vResult As Variant, ByRef lRow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
Dim i As Integer, j As Integer, bSkip As Boolean

For i = IIf(bComb, iElement, 1) To UBound(vElements)
bSkip = False
' in case of permutation without repetition makes sure the element is not yet used
If (Not bComb) And Not bRepet Then
For j = 1 To p
If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
bSkip = True
Exit For
End If
Next
End If

If Not bSkip Then
vResult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
For j = 1 To p
vResultAll(lRow, j) = vResult(j)
Next j
Else
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
End If
End If
Next i
End Sub

#### Vishaal

##### Active Member
Hi Worf,

As per your provided url, find the following error.

Run time error 13
Type mismath

using the following file

 col 1 Col 2 p 10 Combinations FALSE Repetition TRUE SET 0 1 2 3 4 5 6 7 8 9

<tbody>
</tbody>

using the following code

Option Explicit

' PGC Set 2007
' Calculates and writes the Combinations / Permutations with/without repetition
' Assumes the result is written from row 1 down. If the total number of cells in a column
' is less than tha number of results continues in another group of columns to the right.
' vElements - Array with the set elements (1 to n)
' p - number of elements in 1 combination/permutation
' bComb - True: Combinations, False: Permutations
' bRepet - True: with repetition, False: without repetition
' vResult - Array to hold 1 permutation/combination (1 to p)
' lRow - row number. the next combination/permutation is written in lRow+1
' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
' iElement - order of the element to process in case of combination
' iIndex - position of the next element in the combination/permutation

' Sub CombPerm() deals with the input / output
' Sub CombPermNP() generates the combinations / permutations

Sub CombPerm()
Dim rRng As Range, p As Integer
Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
Dim lRow As Long, bComb As Boolean, bRepet As Boolean
Dim vResultPart, iGroup As Integer, l As Long, lMax As Long, k As Long

' Get the inputs and clear the result range (you may adjust for other locations)
Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked
bComb = Range("B2")
bRepet = Range("B3")
Range("D1", Cells(1, Columns.Count)).EntireColumn.Clear

' Error
If (Not bRepet) And (rRng.Count < p) Then
MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"
Exit Sub
End If

' Set up the arrays for the set elements and the result
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
With Application.WorksheetFunction
If bComb = True Then
lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
Else
If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
End If
End With
ReDim vResult(1 To p)
ReDim vResultAll(1 To lTotal, 1 To p)

' Calculate the Combinations / Permutations
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)

' Write the Combinations / Permutations
' Since writing to the worksheet cell be cell is very slow, uses temporary arrays to write one column at a time
Application.ScreenUpdating = False
If lTotal <= Rows.Count Then
Range("D1").Resize(lTotal, p).Value = vResultAll
Else
While iGroup * Rows.Count < lTotal
lMax = lTotal - iGroup * Rows.Count
If lMax > Rows.Count Then lMax = Rows.Count
ReDim vResultPart(1 To lMax, 1 To p)
For l = 1 To lMax
For k = 1 To p
vResultPart(l, k) = vResultAll(l + iGroup * Rows.Count, k)
Next k
Next
Range("D1").Offset(0, iGroup * (p + 1)).Resize(lMax, p).Value = vResultPart
iGroup = iGroup + 1
Wend
End If
Application.ScreenUpdating = True
End Sub

Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
ByVal vResult As Variant, ByRef lRow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
Dim i As Integer, j As Integer, bSkip As Boolean

For i = IIf(bComb, iElement, 1) To UBound(vElements)
bSkip = False
' in case of permutation without repetition makes sure the element is not yet used
If (Not bComb) And Not bRepet Then
For j = 1 To p
If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
bSkip = True
Exit For
End If
Next
End If

If Not bSkip Then
vResult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
For j = 1 To p
vResultAll(lRow, j) = vResult(j)
Next j
Else
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
End If
End If
Next i
End Sub

Help pls

Hi Worf ji,

its working

Thanks bro.....

#### mikerickson

##### MrExcel MVP
For the combinations, you might use this
Code:
``````Sub test()
Dim Alphabet As Variant, Combination() As Boolean
Dim OutArray() As Variant
Dim EndOfCombos As Boolean
Dim Size  As Long, i As Long, j As Long

With Range("A:A")
Alphabet = Application.Transpose(Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value)
End With

ReDim Combination(1 To UBound(Alphabet))
For i = 1 To Size
Combination(i) = True
Next i
ReDim OutArray(1 To Size)
Range("c1").Resize(1, Size).EntireColumn.ClearContents

Do
j = 0
For i = 1 To UBound(Combination)
If Combination(i) Then
j = j + 1
OutArray(j) = Alphabet(i)
End If
Next i
Range("C65536").End(xlUp).Offset(1, 0).Resize(1, Size).Value = OutArray
Combination = NextCombo(Combination, EndOfCombos)
Loop Until EndOfCombos
End Sub

Function NextCombo(ByVal currentCombo As Variant, Optional ByRef Overflow As Boolean) As Variant
Dim LookAt As Long, WriteTo As Long

LookAt = LBound(currentCombo)
WriteTo = LookAt - 1
Overflow = False

Do Until currentCombo(LookAt)
LookAt = LookAt + 1
Loop

Do
WriteTo = WriteTo + 1
currentCombo(LookAt) = False
currentCombo(WriteTo) = True
LookAt = LookAt + 1
If UBound(currentCombo) < LookAt Then Exit Do
Loop While currentCombo(LookAt)

If UBound(currentCombo) < LookAt Then
Overflow = True
Else
currentCombo(WriteTo) = False
currentCombo(LookAt) = True
End If

NextCombo = currentCombo
End Function``````
I don't understand the permutaion question.
Could you give a (small) example

1,082,131
Messages
5,363,337
Members
400,726
Latest member

### This Week's Hot Topics

• populate from drop list with multiple tables
Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
• Find list of words from sheet2 in sheet1 before a comma and extract text vba
Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
• Dynamic Formula entry - VBA code sought
Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...