Randomize/shuffle a list of names

[coliervile]

Good day to everyone,

I need to pair 24 students for testing purposes. This is what I have come up with and I would like to know if my method is overkill or is there an easier way of achieving this.

The information is in column A through G. There is a RAND() formula in columns A, C , and E rows 1-24. Column B are the students names. In column D, F, and G i have this formlua, this is the formula in cell D1, =IF(SUMPRODUCT(COUNTIF($A$1:$A$24,$A$1:$A$24)>1)>0,"Press F9",INDEX($B$1:$B$24,MATCH(LARGE($A$1:$A$24,ROW()),$A$1:$A$24,0)))
This formula does the following:
Column D to the right of the names in column B first checks that all of the random numbers are different, this might be an overkill. I know that the probability of excel of generating the same random number twice in a sampling of 24 is very small, if the numbers are unique then it returns the name next to the nth largest number, where n is specified by the row number, so row D1 contains the name next to the 1st largest random number, row 2 the name next to the 2nd largest number and so on.


In the range of B26:D49 I test to see if there are any duplicates of pairings or if the same name is paired with themselves. Cell B26 has the following formula copied down: =B1&"-"&D1. Cell C26 has the following formula copied down: =D1&"-"&B1. Cell D26 has the following formula copied down: =B26=C26 to test True and/or False. In the range of E26:G49 does the same thing as above comparing columns F and G.


I have a macro in an ActiveX button on the face of Sheet1:

Private Sub CommandButton1_Click()
Dim cnt As Long

With Sheets("Sheet1")

.Calculate
Do While Application.CountIf(.Range("D26:D49", "G26:G49"), "TRUE") > 0

.Calculate
cnt = cnt + 1
Loop

End With
End Sub

This coding was from "xld". The code is suppose to ensure that I do not have any duplicates and if there is it will continue to loop through until there is not.

I'm tring to eliminate students from working with the same students twice, but with my way I do get duplicates. Is there a way to totally randomize or shuffle the names to totally eliminate dupes. Thanks for looking at my question.



0.050355758583651

William

0.363183681524341

Neal

0.612859554908623

Cecil

Duane



0.890258782499172

Elizabeth

0.681864751128359

Don

0.907986882796081

Duane

Melody



0.964350787417417

Neal

0.888941359886682

Tim

0.810594488023610

Steve

Linda



0.740763248503082

Gale

0.767880931691372

Kevin

0.210592042440462

Rich

Steve



0.676794821738603

Mary

0.400700523990329

Elizabeth

0.355326496952177

Russ

Lisa



0.056830767459080

Charlie

0.643994317298083

Terry

0.337587374792008

Tim

Terry



0.063043556397407

Katie

0.929206887532655

Rich

0.348457402974263

Mike

Gale



0.693901214300984

Melody

0.503734906847256

Gale

0.799727590372463

Lisa

Neal



0.673860854917940

Chris

0.145987831640838

Melody

0.034659920181155

Kevin

Cecil



0.636789717695558

Tom

0.398701884393232

Mary

0.311117586559984

Don

Katie



0.854045179133543

Terry

0.417724703128309

Chris

0.743032243905106

Terry

William



0.943675634228936

Tim

0.955556261221306

Duane

0.689227095756083

Gale

Mary



0.271709687967850

Mike

0.190604430804749

Tom

0.363041974378208

Chris

Charlie



0.647268211072764

Duane

0.830242039903891

Lisa

0.193711789758876

Robin

Chris



0.741353245290769

Rich

0.041845584604717

Linda

0.029276333075675

Elizabeth

Russ



0.604283860398354

Lisa

0.415777658346373

Robin

0.489812316334528

Mary

Ann



0.950919887491740

Don

0.225958782530211

Ann

0.657917191659477

Neal

Mike



0.448857488151824

Ann

0.898199027962356

Russ

0.355171282750325

Ann

Tim



0.478138620406055

Linda

0.844581365491523

Mike

0.591849724063178

Katie

Don



0.108777001654113

Cecil

0.933722320849975

Steve

0.165466100916225

Tom

Rich



0.465184872793105

Robin

0.956754970937603

Cecil

0.882032303730319

Melody

Robin



0.921538580153064

Kevin

0.215590752065523

Katie

0.508032034767729

William

Tom



0.367501806104713

Russ

0.006211355483853

Charlie

0.872463887818812

Linda

Kevin



0.190015481191450

Steve

0.116444831449583

William

0.475422458633480

Charlie

Elizabeth













William-Neal

Neal -William

FALSE

Cecil-Duane

Melody-Cecil

FALSE




Elizabeth-Don

Don-Elizabeth

FALSE

Duane-Melody

Linda-Tim

FALSE




Neal -Tim

Tim-Neal

FALSE

Steve-Linda

William-Neal

FALSE




Gale-Kevin

Kevin-Gale

FALSE

Rich-Steve

Gale-Robin

FALSE




Mary-Elizabeth

Elizabeth-Mary

FALSE

Russ-Lisa

Tom-Ann

FALSE




Charlie-Terry

Terry-Charlie

FALSE

Tim-Terry

Katie-Terry

FALSE




Katie-Rich

Rich-Katie

FALSE

Mike-Gale

Robin-Kevin

FALSE




Melody-Gale

Gale-Melody

FALSE

Lisa-Neal

Mary-Don

FALSE




Chris-Melody

Melody-Chris

FALSE

Kevin-Cecil

Duane-Mary

FALSE




Tom-Mary

Mary-Tom

FALSE

Don-Katie

Chris-Elizabeth

FALSE




Terry-Chris

Chris-Terry

FALSE

Terry-William

Elizabeth-Chris

FALSE




Tim-Duane

Duane-Tim

FALSE

Gale-Mary

Steve-Rich

FALSE




Mike-Tom

Tom-Mike

FALSE

Chris-Charlie

Mike-Duane

FALSE




Duane-Lisa

Lisa-Duane

FALSE

Robin-Chris

Charlie-Lisa

FALSE




Rich-Linda

Linda-Rich

FALSE

Elizabeth-Russ

Russ-Melody

FALSE




Lisa-Robin

Robin-Lisa

FALSE

Mary-Ann

Terry-William

FALSE




Don-Ann

Ann-Don

FALSE

Neal -Mike

Kevin-Katie

FALSE




Ann-Russ

Russ-Ann

FALSE

Ann-Tim

Lisa-Linda

FALSE




Linda-Mike

Mike-Linda

FALSE

Katie-Don

Neal -Gale

FALSE




Cecil-Steve

Steve-Cecil

FALSE

Tom-Rich

Ann-Charlie

FALSE




Robin-Cecil

Cecil-Robin

FALSE

Melody-Robin

Rich-Tom

FALSE




Kevin-Katie

Katie-Kevin

FALSE

William-Tom

Don-Russ

FALSE




Russ-Charlie

Charlie-Russ

FALSE

Linda-Kevin

Tim-Mike

FALSE




Steve-William

William-Steve

FALSE

Charlie-Elizabeth

Cecil-Steve

FALSE

[coliervile]

Additional information... the only pairings list I would use are those in B26:B49 and E26:E49.

Thanks

[mikerickson]

In the attached, A1:A24 contains the names of the students
A26:B37 takes that linear list and folds it into pairings.

D1 : D24 reorders A1:A24 so that D26:E37 shows different pairings, all different that A26:B37.

Copying D1:E37 and pasting it to G1, J1, M1, P1, ... BO1 will create round-robin type pairings so that every one is matched with everyone else once and only once.

If you put =RAND() in B1:b24 and sort on column B, that will randomize those results.

[coliervile]

Thank you mikerickson for your idea, it is a differnet way of doing this. I'll make a macro to Calculate and Sort to handle B1:B24.

[Paul_Hossler]

another way is to use an array-entered user defined function

not effecient, but pretty streight forward



Option Explicit
Function RandomPairing(rIn As Range) As Variant
Dim A() As Variant
Dim i As Long, j As Long
Dim sHold As String
Dim dHold As Double
Dim vOut() As String
Dim bNoDups As Boolean

ReDim A(1 To rIn.Columns(1).Rows.Count, 1 To 2)
ReDim vOut(1 To rIn.Columns(1).Rows.Count)

Application.Volatile

bNoDups = True

Do While bNoDups

bNoDups = True

For i = LBound(A, 1) To UBound(A, 1)
A(i, 1) = rIn.Cells(i, 1).Value
A(i, 2) = Rnd
Next i

For i = LBound(A, 1) To UBound(A, 1) - 1
For j = i + 1 To UBound(A, 1)
If A(i, 2) > A(j, 2) Then
sHold = A(j, 1)
A(j, 1) = A(i, 1)
A(i, 1) = sHold
dHold = A(j, 2)
A(j, 2) = A(i, 2)
A(i, 2) = dHold
End If
Next j
Next i

For i = LBound(A, 1) To UBound(A, 1)
If A(i, 1) = rIn.Cells(i, 1).Value Then
bNoDups = False
Exit For
End If
Next i

Loop

For i = LBound(A, 1) To UBound(A, 1)
vOut(i) = A(i, 1)
Next i

RandomPairing = Application.WorksheetFunction.Transpose(vOut)

End Function



Paul

[coliervile]

Thank you Paul for your idea. When I get to work tomorrow I'll take a closer look at it. When I saw your worksheet though I saw that Don was paired with himself as well as Russ.

Thanks

[snb]

It's not about a random list of names, but a random list of unique pairs.

assuming the 24 name in range A2:A25:


Sub M_snb()
[B2:Y24] = [if(row(B2:Y24)<column(B2:Y24),A2:A25&"_"&transpose(A2:A25),"")]

For Each it In [B2:Y24].SpecialCells(2)
c00 = c00 & "|" & it.Value
Next
sn = Split(c00, "|")

[B2:Y24].ClearContents

Cells(1, 3).Resize(UBound(sn) + 1) = Application.Transpose(sn)
Cells(1, 3).Resize(UBound(sn) + 1).Offset(, 1) = "=rand()"
Cells(1, 3).CurrentRegion.Sort Cells(1, 4)
End Sub

[Paul_Hossler]

Thank you Paul for your idea. When I get to work tomorrow I'll take a closer look at it. When I saw your worksheet though I saw that Don was paired with himself as well as Russ.
Thanks


Shouldn't happen, but I'll check. Hmmm -- There was something in the Do While / Loop happening and I don't understand it. I had a 'same name' test but it didn't cause a re-do

I flipped the Do Loop and this works as far as I can see. I did add a test column C as a test




Option Explicit
Function RandomPairing(rIn As Range) As Variant
Dim A() As Variant
Dim i As Long, j As Long
Dim sHold As String
Dim dHold As Double
Dim vOut() As String
Dim bNoDups As Boolean

ReDim A(1 To rIn.Columns(1).Rows.Count, 1 To 2)
ReDim vOut(1 To rIn.Columns(1).Rows.Count)

Application.Volatile

bNoDups = True

Do

bNoDups = True

For i = LBound(A, 1) To UBound(A, 1)
A(i, 1) = rIn.Cells(i, 1).Value
A(i, 2) = Rnd
Next i

For i = LBound(A, 1) To UBound(A, 1) - 1
For j = i + 1 To UBound(A, 1)
If A(i, 2) > A(j, 2) Then
sHold = A(j, 1)
A(j, 1) = A(i, 1)
A(i, 1) = sHold
dHold = A(j, 2)
A(j, 2) = A(i, 2)
A(i, 2) = dHold
End If
Next j
Next i

For i = LBound(A, 1) To UBound(A, 1)
If A(i, 1) = rIn.Cells(i, 1).Value Then
bNoDups = False
End If
Next i

Loop Until bNoDups

For i = LBound(A, 1) To UBound(A, 1)
vOut(i) = A(i, 1)
Next i

RandomPairing = Application.WorksheetFunction.Transpose(vOut)
End Function




Sorry about that

Paul

[snb]

see the attachment