Hello all,
I am using the following macro to assign UniqueID from one sheet into a judges table sheet
although it assigns the UniqueID's between the tables in an even fashion it does not seem to consider logic if a judge is also a participant then do not assign that uniqueid to that table.
I am trying to assign UniqueId's to "Stewards" who will be presenting to the judges entrants
I have attached a copy of the sheet for your viewing.
What I want to achieve is to have the steward flight assignee inject out the unique ID's of the entrants but in a seemingly random pattern and if a judge is a participant at the same table as the steward then they cannot judge their own entry. If that makes sense. Judge2_TestData.xlsm
I am using the following macro to assign UniqueID from one sheet into a judges table sheet
VBA Code:
Sub AssignUniqueIDs()
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim judgeSheet As Worksheet
Dim lastRowSource As Long
Dim lastRowDestination As Long
Dim uniqueIDsRange As Range
Dim cell As Range
Dim name As String
Dim uniqueIDIndex As Long
Dim uniqueIDsCount As Long
Dim stewardCount As Long
Dim uniqueIDsPerSteward As Long
Dim i As Long
Dim foundMatch As Boolean
Dim judgeTables As Collection
' Set source, destination, and judge sheets
Set sourceSheet = ThisWorkbook.Sheets("Registration Hard Data")
Set destinationSheet = ThisWorkbook.Sheets("Steward Flight Assignee")
Set judgeSheet = ThisWorkbook.Sheets("Judge Registration Hard Data")
' Find last rows of source and destination sheets
lastRowSource = sourceSheet.Cells(sourceSheet.Rows.count, "O").End(xlUp).row
lastRowDestination = destinationSheet.Cells(destinationSheet.Rows.count, "C").End(xlUp).row
' Set range of unique IDs
Set uniqueIDsRange = sourceSheet.Range("O4:O" & lastRowSource)
' Determine the count of Steward names and unique IDs
stewardCount = Application.WorksheetFunction.CountA(destinationSheet.Range("C3:L3"))
uniqueIDsCount = lastRowSource - 3
' Calculate the number of unique IDs to be assigned to each Steward name
uniqueIDsPerSteward = Application.WorksheetFunction.RoundUp(uniqueIDsCount / stewardCount, 0)
' Initialize unique ID index
uniqueIDIndex = 1
' Initialize collection to store judge tables
Set judgeTables = New Collection
' Store tables where judges are assigned
For Each cell In judgeSheet.Range("H2:H" & lastRowDestination)
If Not IsEmpty(cell.Value) Then
judgeTables.Add cell.Value
End If
Next cell
' Loop through each cell in row 3 of destination sheet
For Each cell In destinationSheet.Range("C3:L3")
If cell.Value <> "" Then ' Check if the cell is not empty
name = cell.Value
' Find corresponding row in judge sheet
Dim judgeRow As Range
Set judgeRow = judgeSheet.Columns("C").Find(What:=name, LookIn:=xlValues, LookAt:=xlWhole)
If Not judgeRow Is Nothing Then ' Check if match is found
' Check if the judge is also a participant
Dim participantRow As Range
Set participantRow = sourceSheet.Columns("E").Find(What:=name, LookIn:=xlValues, LookAt:=xlWhole)
If Not participantRow Is Nothing Then ' Judge is also a participant
' Check if the judge's entry has been assigned a table
Dim judgeTable As Variant
judgeTable = judgeSheet.Cells(judgeRow.row, "H").Value
If Not IsEmpty(judgeTable) Then
If judgeTables.Contains(judgeTable) Then
' Remove the judge's table from available tables
judgeTables.Remove judgeTable
End If
End If
End If
End If
' Assign unique IDs to destination cells for this Steward name
For i = 1 To uniqueIDsPerSteward
' Check if there are still remaining unique IDs
If uniqueIDIndex <= uniqueIDsCount Then
' Retrieve unique ID from source sheet
Dim uniqueID As Variant
uniqueID = uniqueIDsRange.Cells(uniqueIDIndex).Value
' Check for conflict: if the judge is also a participant and assigned to the same table
If IsConflict(uniqueID, cell, judgeSheet, destinationSheet, judgeTables) Then
' Find the next available table for this steward
Dim nextTableColumn As Long
nextTableColumn = FindNextAvailableTable(destinationSheet, cell.column)
If nextTableColumn > 0 Then
' Assign unique ID to the next available table
destinationSheet.Cells(4 + i - 1, nextTableColumn).Value = uniqueID
End If
Else
' Assign unique ID to destination cell
destinationSheet.Cells(4 + i - 1, cell.column).Value = uniqueID
End If
uniqueIDIndex = uniqueIDIndex + 1
Else
Exit For ' Exit loop if all unique IDs are assigned
End If
Next i
End If
Next cell
MsgBox "Unique IDs have been assigned successfully.", vbInformation
End Sub
Function IsConflict(ByVal uniqueID As Variant, ByVal cell As Range, ByVal judgeSheet As Worksheet, ByVal destinationSheet As Worksheet, ByVal judgeTables As Collection) As Boolean
' Retrieve the participant name associated with the unique ID
Dim participantName As String
participantName = GetParticipantName(uniqueID, destinationSheet)
' Retrieve the judge name at the steward's table
Dim judgeName As String
judgeName = destinationSheet.Cells(3, cell.column).Value
' Check if the participant name is a judge at the same table
If Not IsEmpty(participantName) Then
Dim judgeTable As Variant
judgeTable = destinationSheet.Cells(2, cell.column).Value
If Not IsEmpty(judgeTable) Then
Dim isInJudgeTables As Boolean
isInJudgeTables = False
Dim table As Variant
For Each table In judgeTables
If table = judgeTable Then
isInJudgeTables = True
Exit For
End If
Next table
If isInJudgeTables Then
Dim judgeRow As Range
Set judgeRow = judgeSheet.Columns("C").Find(What:=participantName, LookIn:=xlValues, LookAt:=xlWhole)
If Not judgeRow Is Nothing Then
Dim judgeTableCheck As Variant
judgeTableCheck = judgeSheet.Cells(judgeRow.row, "H").Value
If judgeTableCheck = judgeTable Then
IsConflict = True
Exit Function
End If
End If
End If
End If
End If
' If no conflict is found, return false
IsConflict = False
End Function
Function GetParticipantName(ByVal uniqueID As Variant, ByVal destinationSheet As Worksheet) As String
Dim participantName As String
participantName = ""
Dim participantRow As Range
Set participantRow = destinationSheet.Columns("O").Find(What:=uniqueID, LookIn:=xlValues, LookAt:=xlWhole)
If Not participantRow Is Nothing Then
participantName = destinationSheet.Cells(participantRow.row, "E").Value
End If
GetParticipantName = participantName
End Function
Function FindNextAvailableTable(ByVal sheet As Worksheet, ByVal currentColumn As Long) As Long
Dim tableRange As Range
Dim cell As Range
' Set the range for table numbers
Set tableRange = sheet.Range("C2:L2")
' Start from the column next to the current table
For Each cell In tableRange
If cell.column <> currentColumn Then
' Check if the table number is not already occupied
If Application.WorksheetFunction.CountA(sheet.Cells(4, cell.column).Resize(sheet.Rows.count - 3)) = 0 Then
FindNextAvailableTable = cell.column
Exit Function
End If
End If
Next cell
' If no available table is found, return 0
FindNextAvailableTable = 0
End Functionalthough it assigns the UniqueID's between the tables in an even fashion it does not seem to consider logic if a judge is also a participant then do not assign that uniqueid to that table.
I am trying to assign UniqueId's to "Stewards" who will be presenting to the judges entrants
I have attached a copy of the sheet for your viewing.
What I want to achieve is to have the steward flight assignee inject out the unique ID's of the entrants but in a seemingly random pattern and if a judge is a participant at the same table as the steward then they cannot judge their own entry. If that makes sense. Judge2_TestData.xlsm
