# Problems with Random sorting macro

#### LuukRost

##### New Member
Hi,

I work in a school and i have to make an excelsheet that assigns the names from the students into cells on a new tab to randomly assign them to seats when taking tests or exams.

So i have one tab called "students", in this tab there is a row from A3 to A36 for the first class of students.
In the second tab called "sorting" i have a mock setup of the class layout so 4 tables wide and 7 tables long with the range B3 to E9.

What i want to do is make a macro button that takes the names of the students in tab "students" and randomly sorts them into the class layout in the tab "sorting".

I have gone so far as to make the macro working but it removes the references to the student cells in the "students" tab.

I am pretty ok with some light coding but this is a bit challenging, hence the post.

Can anyone help me with this?

This is the code:

Sub Rechthoek1_Klikken()
Dim v As Variant, t As Variant, x As Long
Dim RwCell1 As Long, RwCell2 As Long, ColCell1 As Long, ColCell2 As Long
Dim Rw As Long, Col As Long, Iterations As Long
v = Selection.Value
Rw = Selection.Rows.Count
Col = Selection.Columns.Count
Iterations = Rw * Col
For x = Iterations To 1 Step -1

RwCell1 = Int(1 + Rw * Rnd)
RwCell2 = Int(1 + Rw * Rnd)
ColCell1 = Int(1 + Col * Rnd)
ColCell2 = Int(1 + Col * Rnd)
If Selection.Rows.Count = 1 Then
If ColCell1 <> ColCell2 Then
t = v(RwCell1, ColCell1)
v(RwCell1, ColCell1) = v(RwCell2, ColCell2)
v(RwCell2, ColCell2) = t
End If
ElseIf Selection.Columns.Count = 1 Then
If RwCell1 <> RwCell2 Then
t = v(RwCell1, ColCell1)
v(RwCell1, ColCell1) = v(RwCell2, ColCell2)
v(RwCell2, ColCell2) = t
End If
Else
If RwCell1 <> RwCell2 And ColCell1 <> ColCell2 Then
t = v(RwCell1, ColCell1)
v(RwCell1, ColCell1) = v(RwCell2, ColCell2)
v(RwCell2, ColCell2) = t
End If
End If
Next x
Selection.Value = v
End Sub

### Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

#### Special-K99

##### Well-known Member
This code just sorts rows A3:A36.
Are you saying you want the randomly sorted list assigned to cells B3:E9 in another macro that youre unable to perfect?

Does this get any nearer for you? (untested)
NOTE: The last 6 students will not be assigned a cell as you only have 28 positions B3:E9 and 34 students A3:A36
If you want them assigned increase the "For k" loop to go from 9 to 11

Code:
i=3
for j=2 to 5
for k=3 to 9
Worksheets("sorting").cells(k,j)=Worksheets("students").cells(1,i)
i=i+1
next k
next j

Last edited:

#### gallen

##### Well-known Member
As an alternative, using a collection:

Code:
Sub SortClass()

Dim colStudents As New Collection
Dim c As Range
Dim iRnd As Integer

For Each c In Sheets("Students").Range("A3:A36")
Next

'Loop through each cell in the seating plan range
For Each c In Sheets("Sorting").Range("B3:E9")
'get random number from remaining number of students
Randomize
iRnd = Int(colStudents.Count * Rnd + 1)
'Add dtudent name to the seating plan
c = colStudents(iRnd)
'remove the added student from the collection
colStudents.Remove (iRnd)
Next

End Sub

As Special-K99 rightly states you have more students than seats though. Is this correct?

Last edited:

#### LuukRost

##### New Member
As an alternative, using a collection:

Code:
Sub SortClass()

Dim colStudents As New Collection
Dim c As Range
Dim iRnd As Integer

For Each c In Sheets("Students").Range("A3:A36")
Next

'Loop through each cell in the seating plan range
For Each c In Sheets("Sorting").Range("B3:E9")
'get random number from remaining number of students
Randomize
iRnd = Int(colStudents.Count * Rnd + 1)
'Add dtudent name to the seating plan
c = colStudents(iRnd)
'remove the added student from the collection
colStudents.Remove (iRnd)
Next

End Sub

As Special-K99 rightly states you have more students than seats though. Is this correct?

This is correct since im building the sheet but do not have the total number of students.
Thanks, i am trying both methods as we speak. will send feedback soon.

#### LuukRost

##### New Member
This code just sorts rows A3:A36.
Are you saying you want the randomly sorted list assigned to cells B3:E9 in another macro that youre unable to perfect?

If by that you mean, extract the names from "students" and sort them randomly to cells B3:E9, than yes!

#### LuukRost

##### New Member
This method works, awesome!! thank you so much!

#### gallen

##### Well-known Member
Good news!

Which method worked?

#### LuukRost

##### New Member
Good news!

Which method worked?

i tried your method and that worked like a dream, thanks!

I have one last question, is it possible to do the same for a double cell value?
So you have a student name and their id number, and i want that linked.

So student A ("Students" Cell A1) and his student id ("Students" Cell B1) shuffled together to "sorting" Cell A1 and Cell A2 and that those values stay the same after the random function. That would mean they start in Cell A1 and A2, *click* C6 and C7 *click* B22 and B23 and so on.

Do you have a suggestion?

#### gallen

##### Well-known Member
Yes, straight forward as you aren't randomising any cells but the collection. So you'd change
Code:
To

Code:
colStudents.Add c.Value & " " & c.Offset(0,1).Value

Try that and let me know if that's what you meant.

#### LuukRost

##### New Member
Yes, straight forward as you aren't randomising any cells but the collection. So you'd change
Code:
To

Code:
colStudents.Add c.Value & " " & c.Offset(0,1).Value

Try that and let me know if that's what you meant.

This is perfect! i had it setup differently in my head but this is much simpler and more clean!

Thank you so much!

Replies
3
Views
816
Replies
12
Views
464
Replies
0
Views
423
Replies
0
Views
402
Replies
2
Views
254

1,195,902
Messages
6,012,202
Members
441,679
Latest member
GDOG_27

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back