Distribute students to specific dates for courses with limited seats

[wierts]

Hi all,

This is my first attempt at asking for excel help so please bear with me....

I have the following challenge:

I have a group of students who have to take a specific course (in simulated environment).
This course has limited 'seats' available 2 or 4 depending on the dates.

So i have about 50 students and 18 dates available to slot in 2 or 4 students.
The challenge is i have to slot in every student once and do this randomly. What student slots into what 'date' is of no importance, but the maximum should not be exceeded (2 or 4).

Is there a method to distribute the names to the dates automatically using excel?

The dates are in C4:C22 and the names are in A4:a54
All other space i have not used.

can you give me a pointer to porceed

Should my explanation lack in clarity please

 

[JLGWhiz]

Hi wierts, Welcome to Mr.Excel
You might be able to use these procedures. The first is a function which should be copied to the top of your standard code module1. The second is the code that executes the function and it should also be copied to your standard code module. To use the procedures, run the second procedure. It will display an input box where you can enter the quantity of random numbers to select from a field of 1 To 50. It will display the selected numbers beginning in cell A3 and continuing down that column for as many cells as the quantity entered in the input box. A second selection will overwrite the previous selection. You can then use those numbers to identify the qualifying students. There is no guarantee that any given number will be limited to only four occurrences. You might want to run this in a new file.

Code:

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant
' creates an array with NumCount unique long random numbers in the range LLimit - ULimit (including)
Dim RandColl As Collection, i As Long, varTemp() As Long
UniqueRandomNumbers = False
If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount
ReDim varTemp(1 To NumCount)
For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i
Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
End Function

' example use:

Sub TestUniqueRandomNumbers()
Dim varrRandomNumberList As Variant, x As Long
x = Application.InputBox("Enter an integer value less than 50", "QUANTITY TO SELECT", Type:=1)
varrRandomNumberList = UniqueRandomNumbers(x, 1, 50)
Range(Cells(3, 1), Cells(3 + x - 1, 1)).Value = _
Application.Transpose(varrRandomNumberList)
End Sub