View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
K Dales[_2_] K Dales[_2_] is offline
external usenet poster
 
Posts: 1,163
Default help - how to move cells into an array using criteria

OK, got the code written and seems to work, though I won't guarantee it is
bug-free. New approach steps through groups first - a bit more efficient.
My code assumes a few things:
Sheet with student list is called "STUDENTS" and has 3 columns with labels
in first row: student ID, Class, Homeroom - in that order. Another sheet
called "GROUPS" has a pre-built list of the groups, again starting in A1 and
having labels in 1st row: 1st column does not matter to the routine, but 2nd
must be the proctor and entries must match the "homeroom" from the student
list exactly. Columns 3,4,5,6 are for the four students to be listed (by the
ID from the student list).
I still cannot guarantee a full solution, but if a student cannot be found
to match a group, two things happen:
- A new worksheet called UNASSIGNED is created and any students who could
not be fit into existing openings will be listed on this sheet. A blank list
means all students were assigned to groups.
- Any group openings that could not be filled will be labelled "UNASSIGNED"
on the group list sheet.
Tests with a few random samples of 1500 students worked every time I tested
it with no students left unassigned, and on my 750MHz machine it does the
processing in less than a minute.
You could add even more criteria - looking at how I test the criteria using
the boolean variable Success should give a clue what you would need to do if
you decided to do this.

With all that, here is the code:

Public Sub FormGroups()
' Iterates through group list and assigns 4 students(max) to each group
' If routine has problems finding eligible student in reasonable number of
attempts
' student will be left on "UNASSIGNED" list (new sheet created by this
routine)
' If "UNASSIGNED" list is empty, all students are in appropriate groups!

Dim SSheet As Worksheet
Dim SList As Range, GList As Range
Dim SCount As Integer, GCount As Integer, GStep As Integer, SStep As Integer
Dim Iterations As Integer, Success As Boolean
Dim SRow As Integer, CCheck As Integer
Dim SClass(4) As String, MyClass As String, Homeroom As String, Proctor As
String
Dim CalcMode As Integer

' Turn off automatic calculation if it is on, to help with speed
CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

' Make sure routine can run!
Success = True

For Each SSheet In ThisWorkbook.Worksheets
Success = Success And (SSheet.Name < "UNASSIGNED")
Next SSheet

Success = Success And _
((Sheets("STUDENTS").Range("A1").CurrentRegion.Row s.Count - 1) / _
(Sheets("GROUPS").Range("A1").CurrentRegion.Rows.C ount - 1) <= 4#)

If Success Then

' Initialize variables...
' First create a copy of the student list to work with
Set SSheet = Worksheets.Add
SSheet.Name = "UNASSIGNED"
Set SList = Sheets("STUDENTS").Range("A1").CurrentRegion
SList.Copy
SSheet.Range("A1").PasteSpecial xlPasteValues
SSheet.Range("A1").PasteSpecial xlPasteFormats
SSheet.Range("A1").PasteSpecial xlPasteColumnWidths

' Step through the groups:
Set GList = Sheets("GROUPS").Range("A1").CurrentRegion
GCount = GList.Rows.Count - 1
For GStep = 1 To GCount

Proctor = GList.Range("A1").Offset(GStep, 1).Value

' Set up a range with the remaining students and count them
Set SList = SSheet.Range("A1").CurrentRegion
SCount = SList.Rows.Count - 1

' Find a maximum of 4 students for the group
If SCount 4 Then SStep = 4 Else SStep = SCount
InGroup = 0
SClass(1) = ""
SClass(2) = ""
SClass(3) = ""
SClass(4) = ""
While SStep 0

' Try to find a qualifying student
Iterations = 0 ' To count failed attempts
Success = False ' To flag if student meets criteria

' Keep picking until we find one (or have tried too many times
with no success)
While (Not Success) And (Iterations < (SCount * 4))

Iterations = Iterations + 1
Success = True
' Pick a student at random
Randomize
SRow = Int(Rnd() * SCount) + 1

' Now see if all criteria are met:

' Check Homeroom Teacher vs Proctor:
Homeroom = SList.Offset(SRow, 2).Range("A1").Value
Success = Success And (Homeroom < Proctor)

' Check class against other group members
' (Note: SClass array contains blank string for any
unassigned group members
MyClass = SList.Offset(SRow, 1).Range("A1").Value
For CCheck = 1 To 4
Success = Success And Not (MyClass = SClass(CCheck))
Next CCheck

Wend

' If the student was a match:
If Success Then
' Add them to group
GList.Range("B1").Offset(GStep, SStep) = _
SList.Offset(SRow, 0).Range("A1").Value
SClass(SStep) = MyClass
' Delete them from list of unassigned students
SList.Offset(SRow, 0).Range("A1").EntireRow.Delete
Set SList = SSheet.Range("A1").CurrentRegion
SCount = SList.Rows.Count - 1
Else
'Show that no match was found
GList.Range("B1").Offset(GStep, SStep) = "UNASSIGNED"
End If

SStep = SStep - 1
Wend

Next GStep

Else ' MESSAGE IF CONDITIONS FOR SUCCESSFUL COMPLETION ARE VIOLATED:

MsgBox "ABORTING: Routine cannot run if a sheet is already named
'UNASSIGNED'" _
& " or if there are too few groups (4 students/group maximum)" _
, vbExclamation, "CANNOT PROCESS GROUPS"

End If

' Return to original calculation mode
Application.Calculation = CalcMode

Set SList = Nothing
Set GList = Nothing
Set SSheet = Nothing

End Sub

Hope this works for you, or at least gives a "template" you can modify and
work with. It really was a fun challenge - I enjoyed it.

By the way, if you are interested, I realized it is in some ways analogous
to a game of solitai Imagine a game where you turn up cards from a one
deck and lay them out face up in a row. Then, from another 4 decks, you turn
up cards one at a time and place them under the original cards so that in the
end you have 4 cards underneath each of the starter cards - no two of the 4
can be the same suit, and none of them can match the number of the original
card. If you can do it all without rearranging any you win! The numbers
involved are different, but the principle is the same... (and that is why I
don't think you can "guarantee" a win without stacking the deck - just
haven't found out how to do that!)

K Dales

"bonkerz" wrote:

hi everyone - we need to assign students to testing groups which consist of
four people, but they cannot be from the same class, and their homeroom
teachers cannot be their test proctors. so we have a long (1500 or so) list
of ID numbers, in the next column their class #s, and in the next column
their homeroom teacher. is there any way to automatically assign them to
particular groups and times so that the two exclusionary criteria are met?

thanks for the help, not sure if this is possible in excel but thought i'd
give it a try

bill