Sub RandomPairing() Dim Cnt As Long, RandomIndex As Long, Tmp As Variant, Arr As Variant, lastrow As Long Sheets("helper blind").Activate With ActiveSheet lastrow = .Range("A6:A250").Find("*", searchdirection:=xlPrevious, searchorder:=xlByColumns, LookIn:=xlValues).Row End With Randomize: Randomize Arr = Range("A6", "A" & lastrow) For Cnt = UBound(Arr) To 1 Step -1 RandomIndex = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr)) Tmp = Arr(RandomIndex, 1) Arr(RandomIndex, 1) = Arr(Cnt, 1) Arr(Cnt, 1) = Tmp Next Range("M6").Resize(UBound(Arr)) = Arr Range("M6").Offset(UBound(Arr) / 2).Resize(UBound(Arr)).Cut Range("N6") Call PlaceTeams End Sub
At the suggestions of @StephenCrump I've created this thread to try and come up with some code to generate random pairs with not duplicating any pre-existing pairs. The original thread can be found here if you want to see how it started.
Leading into the code above, the user will enter a list of participants that will be placed in column A beginning with row 6. The issue is some of the names in the list will already be paired with another name in the list and I need to ensure the randomized pairs don't match up with the pairs already entered. The existing pairs are in another sheet in column C beginning in row 5. Each pair in this column is in adjacent rows (C5 is paired with C6, C7 is paired with C8, etc.)
I'm open to new code that will randomize the list after taking into account the existing pairs OR a snippet of code that will compare the randomized pairs to the existing pairs and re-randomize as many times as needed so no pairs match.