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.

[TABLE="width: 440"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] List of Permutations
[/TD]
[/TR]
[TR]
[TD]Name
[/TD]
[TD]Group
[/TD]
[TD]Employee A
[/TD]
[TD]Employee B
[/TD]
[/TR]
[TR]
[TD]Bob
[/TD]
[TD]1
[/TD]
[TD]Bob
[/TD]
[TD]Ginger
[/TD]
[/TR]
[TR]
[TD]Ginger
[/TD]
[TD]1
[/TD]
[TD]Ginger
[/TD]
[TD]Bob
[/TD]
[/TR]
[TR]
[TD]Tommy
[/TD]
[TD]2
[/TD]
[TD]Tommy
[/TD]
[TD]Dave
[/TD]
[/TR]
[TR]
[TD]Dave
[/TD]
[TD]2
[/TD]
[TD]Dave
[/TD]
[TD]Tommy
[/TD]
[/TR]
[TR]
[TD]Wendy
[/TD]
[TD]3
[/TD]
[TD]Wendy
[/TD]
[TD]Trisha
[/TD]
[/TR]
[TR]
[TD]Trisha
[/TD]
[TD]3
[/TD]
[TD]Wendy
[/TD]
[TD]Cindy
[/TD]
[/TR]
[TR]
[TD]Cindy
[/TD]
[TD]3
[/TD]
[TD]Wendy
[/TD]
[TD]Robert
[/TD]
[/TR]
[TR]
[TD]Robert
[/TD]
[TD]3
[/TD]
[TD]Trisha
[/TD]
[TD]Wendy
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Trisha
[/TD]
[TD]Cindy
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Trisha
[/TD]
[TD]Robert
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Cindy
[/TD]
[TD]Wendy
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Cindy
[/TD]
[TD]Trisha
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Cindy
[/TD]
[TD]Robert
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Robert
[/TD]
[TD]Wendy
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Robert
[/TD]
[TD]Trisha
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Robert
[/TD]
[TD]Cindy
[/TD]
[/TR]
</tbody>[/TABLE]

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