Pairing individuals up in groups of 4

[lbgilb]

Hello,
I'm trying to pair create groups of four with a list that has duplicates. Since there are duplicates, I would like to be able to sort the groups so that duplicates aren't in the same group.

Ex. - Here is a list of 8 individuals but Player 1 is listed twice. How would I be able to create two groups with Player 1 not being in the same group?
Player 1
Player 2
Player 3
Player 4
Player 5
Player 6
Player 7
Player 1

Thanks for the help!

 

[mikenelena]

Hi,

The basic idea would be to create a loop that iterates over the list, and assigns each item to a group. When assigning an item to a group, you can check if the group already has a duplicate of the item; if so, you can skip to the next group. You can also create a structure to store the groups, such as an array or dictionary. For example, you could create a two-dimensional array with two rows and four columns. For each item in the list, you could loop through the array and check if the item already exists in a group, and if not, assign it to the first available group. Once you've assigned all the items, you can then loop through the array to print out the groups. The exact code would depend on the specific details of your data structure. Hopefully, this might get you started:

Sub CreateGroups()

Dim playerList As Range
Set playerList = Range("A1:A8")

Dim groupArray(1 To 2, 1 To 4) As Variant
Dim groupIndex As Integer
groupIndex = 1

For Each player In playerList
    Dim groupAlreadyContainsPlayer As Boolean
    groupAlreadyContainsPlayer = False
    
    ' check if the group already contains the player
    For i = 1 To 4
        If groupArray(groupIndex, i) = player Then
            groupAlreadyContainsPlayer = True
            Exit For
        End If
    Next
    
    ' assign the player to the group if it doesn't already contain the player
    If Not groupAlreadyContainsPlayer Then
        For j = 1 To 4
            If IsEmpty(groupArray(groupIndex, j)) Then
                groupArray(groupIndex, j) = player
                Exit For
            End If
        Next
    End If
    
    ' go to the next group if this one is full
    If Not IsEmpty(groupArray(groupIndex, 4)) Then
        groupIndex = groupIndex + 1
    End If
    
Next

' print out the groups to column D, separated by a blank cell
Range("D1").Resize(2, 4).Value = groupArray
Range("D5").Value = ""

End Sub