I designed this so that it can easily handle any number of players selected from a list of members, which are assigned a random Role from an unlimited list of possible roles
The result is that Assignments is a 2D array wherethe first "column" is a random list of player names and the second "Column" is a list of randomly assigned Role Names.
It Complies, but is untested
Option Explicit
Dim Assignments As Variant
Dim NumPlayers As Long
Dim NumRoles As Long
Sub Main()
NumPlayers = 5 'NumPLayers Can be set by UserForm
NumRoles = 5 'NumRoles Can be set by UserForm
ReDim NewPlayers(1 To NumPlayers)
ReDim Roles(1 To NumPlayers)
ReDim Assignments(1 To NumPlayers, 1 To 2)
Dim NextPlayer, NextRole, Newrole
Dim P As Long, R As Long, i As Long
'Set Players in Random order
For P = 1 To NumPlayers
ResetRandomPlayer:
NextPlayer = MemberNames(RandomNumbers(UBound(MemberNames))) 'UBound member names is Upper Limit for Random numbers
For i = 1 To UBound(Assignments)
If NextPlayer = Assignments(i, 1) Then GoTo ResetRandomPlayer 'No Duplicates
Next i
Assignments(P, 1) = NextPlayer
'Set Roles in Random order
ResetRandomRole:
NextRole = PossibleRoles(RandomNumbers(UBound(PossibleRoles)))
For i = 1 To UBound(Assignments)
If NextRole = Roles(i) Then GoTo ResetRandomRole
Roles(i) = NextRole 'Store Next Role for Duplicate Check
Next i
Assignments(P, 2) = NextRole
Next P
End Sub
Function MemberNames() As Variant
'MemberNames can be replaced by a UserForm
MemberNames = Array("Adam", "Bill", "Charles", "Dan", "Edward")
End Function
Function PossibleRoles() As Variant
PossibleRoles = Array("King", "Queen", "Bishop", "Knight", "Rook") 'List all possible roles
End Function
Function RandomNumbers(UpLimit As Long) As Long
'Your code here.
'Code for numbers from 1 to UpLimit
End Function