Randomly shuffle cells using macro button

[SaraWitch]

Hello all,

I have a list of names, two of whom need to call each other each week. This needs to randomly shuffle on a weekly basis and no two names must match or be the same ones calling each other. I am halfway there, but am still getting two names matched and the same ones calling each other when using F9 to shuffle. The second part of my query is I wondered if there is a VBA that can be used with a macro button instead of using F9?

Stay connected template.xlsx
	B	C	D	E	F
2	Name	calls	Name
3	Paul Jones	0.1	Jane Doe
4	John Smith	0.8	Paul Jones
5	Tracy Waters	0.3	Sandra Grass
6	Sandra Grass	0.2	John Doe
7	John Doe	0.5	John Smith
8	Jane Doe	0.3	Tracy Waters
Call Register (2)

Cell Formulas
Range	Formula
C3:C8	C3	=RAND()
D3:D8	D3	=INDEX($B$3:$B$8,RANK(C3,$C$3:C$8,),1)

Ta muchly, folks!
Sara

 

[Logit]

Sub AssignGroups()
'
' AssignGroups Macro
'

'
    ActiveWorkbook.Worksheets("Group Generator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Group Generator").AutoFilter.Sort.SortFields.Add _
        Key:=Range("A1:A33"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Group Generator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Download workbook : Random Group Generator.xlsm

Change the numbers in Col A to the employee names.

 

[Rick Rothstein]

Here is a macro that will populate Column C with random names (but not the name in Column A on the same row). Note that I do not make use of Column B at all... so if you want to output the names to that column, change the red highlighted "C" to a "B".

Sub RandomizeCalls()
  Dim Cnt As Long, RandomIndex As Long, Nms As String, NameList As Variant, People As Variant
  Randomize
  NameList = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
  People = NameList
  For Cnt = UBound(People) To 1 Step -1
    RandomIndex = Int(Cnt * Rnd + 1)
    Nms = Nms & "|" & People(RandomIndex, 1)
    People(RandomIndex, 1) = People(Cnt, 1)
  Next
  For Cnt = 1 To UBound(People)
    Cells(1 + Cnt, "C").Value = Split(Split(Nms & Nms, NameList(Cnt, 1))(1), "|")(1)
  Next
End Sub

 

[Eric W]

Here's a way to do it with formulas:

Book1
	B	C	D
2	Name	calls	Name
3	Paul Jones		Jane Doe
4	John Smith		Tracy Waters
5	Tracy Waters		Sandra Grass
6	Sandra Grass		Paul Jones
7	John Doe		John Smith
8	Jane Doe		John Doe
Sheet16

Cell Formulas
Range	Formula
D3:D8	D3	=INDEX(B:B,AGGREGATE(15,6,ROW($B$3:$B$8)/($B$3:$B$8<>B3)/(COUNTIF($D$2:$D2,$B$3:$B$8)=0)/(COUNTIFS($B$2:$B2,$B$2:$B$8,$D$2:$D2,B3)=0),RANDBETWEEN(1,ROWS($D3:$D$8))))

Nothing in column C is required. You may have to press F9 several times until you get a list without #NUM in it.

 

[SaraWitch]

Thank you all.

Logit - your formula is giving me this error message:

But, Rick, yours works really well for me - thank you! I would just like to shuffle the names from row 3 though, not row 2 (because it shuffles the title 'Name' also)...

 

[Rick Rothstein]

But, Rick, yours works really well for me - thank you! I would just like to shuffle the names from row 3 though, not row 2 (because it shuffles the title 'Name' also)...

Oops! Sorry, my fault... I did not notice your headers were on Row 2. Here is my code modified to work with your actual setup...

Sub RandomizeCalls()
  Dim Cnt As Long, RandomIndex As Long, Nms As String, NameList As Variant, People As Variant
  Randomize
  NameList = Range("A3", Cells(Rows.Count, "A").End(xlUp)).Value
  People = NameList
  For Cnt = UBound(People) To 1 Step -1
    RandomIndex = Int(Cnt * Rnd + 1)
    Nms = Nms & "|" & People(RandomIndex, 1)
    People(RandomIndex, 1) = People(Cnt, 1)
  Next
  For Cnt = 1 To UBound(People)
    Cells(2 + Cnt, "C").Value = Split(Split(Nms & Nms, NameList(Cnt, 1))(1), "|")(1)
  Next
End Sub

 

[SaraWitch]

No apology, please! This is great! I had changed the first range to 'A3', but missed the last line 'Cells(2 +....'!

Thank you so much for your help, Rick.

Stay safe, and wishing you a happy, peaceful festive season...