Calculating permutations by grouping and then listing them all together in one column

[Hawk11ns]

Hello everyone, I have been using the below macro to calculate the number of permutations (output columns C onward) for a list (input column A) based on the number chosen (input column B). However, I now have a list that is further broken down by groupings. My goal is to be able to input this list into Column A with the corresponding group number in column B, input the number chosen in column c, and have the permutation output for each group listed all together in column C onwards. The permutations need to be calculated at the group level, meaning that items in group 1 should not be permuted against those in any other group. As always, any and all advice is appreciated. Thanks!

Below is the example output I am looking for.

		List of Permutations
Name	Group	Employee A	Employee B
Bob	1	Bob	Ginger
Ginger	1	Ginger	Bob
Tommy	2	Tommy	Dave
Dave	2	Dave	Tommy
Wendy	3	Wendy	Trisha
Trisha	3	Wendy	Cindy
Cindy	3	Wendy	Robert
Robert	3	Trisha	Wendy
		Trisha	Cindy
		Trisha	Robert
		Cindy	Wendy
		Cindy	Trisha
		Cindy	Robert
		Robert	Wendy
		Robert	Trisha
		Robert	Cindy

<tbody>
</tbody>

Sub Permutations()
Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant
 
Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of values
p = Range("B1").Value ' How many are picked
 
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Application.ScreenUpdating = False
Call PermutationsNP(vElements, CInt(p), vresult, lRow, 1)
Application.ScreenUpdating = True
End Sub
 
Sub PermutationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iIndex As Integer)
Dim i As Long, j As Long, bSkip As Boolean
 
For i = 1 To UBound(vElements)
    bSkip = False
    For j = 1 To iIndex - 1
        If vresult(j) = vElements(i) Then
            bSkip = True
            Exit For
        End If
    Next j
    If Not bSkip Then
        vresult(iIndex) = vElements(i)
        If iIndex = p Then
            lRow = lRow + 1
            Range("C" & lRow).Resize(, p) = vresult
        Else
            Call PermutationsNP(vElements, p, vresult, lRow, iIndex + 1)
        End If
    End If
Next i
End Sub

 

[MickG]

Try this:-
Results start column "C"

Option Explicit
Dim lrow As Long
Sub perm()
Dim rng As Range, Dn As Range, n As Long, K As Variant
Set rng = Range("B2", Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn.Offset(, -1)
    Else
        Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, -1))
    End If
Next
For Each K In .keys
    Call Permutations(.Item(K))
Next K
End With
End Sub
Sub Permutations(rng)
Dim rRng As Range, p
Dim vElements, vresult As Variant
 Set rRng = rng
p = 2
If Not lrow = 0 Then lrow = lrow + 1
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Application.ScreenUpdating = False
Call PermutationsNP(vElements, CInt(p), vresult, lrow, 1)
Application.ScreenUpdating = True
End Sub
 
Sub PermutationsNP(vElements As Variant, p As Integer, vresult As Variant, lrow As Long, iIndex As Integer)
Dim i As Long, j As Long, bSkip As Boolean
 
For i = 1 To UBound(vElements)
    bSkip = False
    For j = 1 To iIndex - 1
        If vresult(j) = vElements(i) Then
            bSkip = True
            Exit For
        End If
    Next j
    If Not bSkip Then
        vresult(iIndex) = vElements(i)
        If iIndex = p Then
            lrow = lrow + 1
            Range("C" & lrow).Resize(, p) = vresult
        Else
            
            Call PermutationsNP(vElements, p, vresult, lrow, iIndex + 1)
        End If
    End If
Next i
End Sub

 

[Hawk11ns]

Thanks but I receive a 'Type Mismatch' error. When I step into debug mode, it takes me to this specific line:

For i = 1 To UBound(vElements)

 

[MickG]

Try this example :-
https://app.box.com/s/uxzwvyoqqdtsesv2tq3am3iok1nd8ou3