Problems with Random sorting macro

LuukRost

New Member
Joined
Dec 8, 2016
Messages
6
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?

Thanks in advance!

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

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
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:
Upvote 0
As an alternative, using a collection:

Code:
Sub SortClass()

Dim colStudents As New Collection
Dim c As Range
Dim iRnd As Integer
    
    'Add students to a collection
    For Each c In Sheets("Students").Range("A3:A36")
        colStudents.Add c.Value
    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:
Upvote 0
As an alternative, using a collection:

Code:
Sub SortClass()

Dim colStudents As New Collection
Dim c As Range
Dim iRnd As Integer
    
    'Add students to a collection
    For Each c In Sheets("Students").Range("A3:A36")
        colStudents.Add c.Value
    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.
 
Upvote 0
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!
 
Upvote 0
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?
 
Upvote 0
Yes, straight forward as you aren't randomising any cells but the collection. So you'd change
Code:
colStudents.Add c.Value
To

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

Try that and let me know if that's what you meant.
 
Upvote 0
Yes, straight forward as you aren't randomising any cells but the collection. So you'd change
Code:
colStudents.Add c.Value
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!
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,040
Members
448,543
Latest member
MartinLarkin

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top