Combination And Permutation with no repeat

[Vishaal]

Thanks in advance

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.

 

[Worf]

Here: https://www.mrexcel.com/forum/excel-questions/277924-combination-help-5.html#post1424848

 

[Vishaal]

Thanks bro

 

[Vishaal]

hi,

i have tried but its showing error

using the following sheet

[TABLE="width: 152"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Col 1[/TD]
[TD]Col 2[/TD]
[/TR]
[TR]
[TD]p[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Combinations[/TD]
[TD="align: center"]FALSE[/TD]
[/TR]
[TR]
[TD]Repetition[/TD]
[TD="align: center"]TRUE[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Set[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: right"]9[/TD]
[/TR]
</tbody>[/TABLE]

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]

Hi Worf,

As per your provided url, find the following error.

Run time error 13
Type mismath

using the following file

[TABLE="width: 500"]
<tbody>[TR]
[TD]col 1[/TD]
[TD]Col 2[/TD]
[/TR]
[TR]
[TD]p[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]Combinations[/TD]
[TD]FALSE[/TD]
[/TR]
[TR]
[TD]Repetition[/TD]
[TD]TRUE[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SET[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]9[/TD]
[/TR]
</tbody>[/TABLE]


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

 

[Vishaal]

Hi Worf ji,

its working

Thanks bro.....

 

[mikerickson]

For the combinations, you might use this

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
    
    Size = 5: Rem adjust
    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