Jim,

Thank you so much for your code.
I have the chance to try it with a much "bigger" data set and compare the
results with the "manual" method Tushar suggested in the weekend...
As you have made it clear in your previous posts, there are lots of
occasions that the code tends to calculate "wrong" Dept. names compared to
Tushar's. Records having the same points, records with same names or blank
Dept. Names, records with higher points then the ones with 2nd choice but
having the same dept as their 3thcoice...etc introduce trouble.

One thing for sure. If I sort the list before executing the macro then the
results with the "manual method" and "VBA code method" are the same.
So I am using the code like this now:
1. Sorting the whole data with ref. to the Points column "descending".
2. Execute your VBA code.
Sincerely
J_J



"Jim Cone" wrote in message
...
J_J,

The point values for B and C were reversed.
Also, the code needed a check to determine if
a name had been assigned.
Since there are two Judys, I renamed the last one to Judy2.
You did say you wanted code you could work on <g.

I get the following results:
'-------------------------------------------------------
A Martyn Nancy Judy
B Sue Mac Mag Jon
C Karen John Judy2 Bush

'-------------------------------------------------------


See how this works...

'-----------------------------------------------'
Jim Cone - San Francisco, USA - March 17, 2005
' Modified on March 18, 2005
'-----------------------------------------------
'Uses data in Range B5:F17
'Name Points 1stChoice 2ndChoice 3rdChoice
'Nancy 90 A C B
'etc.

'Determines names of students for each class
'and lists them in Range B20:E22
'NOTE: there are lots of ways for this to go wrong...
' The data has to be in the specified range.
' There must enough people qualified for all of the classes,
' or you can get an endless loop.
' Duplicate entries
' Others ?
'-----------------------------------------------
Sub FillClasses()
Dim arr1st() As String
Dim arr2nd() As String
Dim arr3rd() As String
Dim lngCol As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim rngCell As Excel.Range
Dim rngPointList As Excel.Range

Set rngPointList = Range("C5:C17")
lngCol = 2
ReDim arr1st(1 To 3)
ReDim arr2nd(1 To 4)
ReDim arr3rd(1 To 4)
'These cells will be cleared as each name is assigned.
Range("A6:A17").Value = "X"

StartOver:
For Each rngCell In rngPointList
Select Case rngCell.Value

Case Is 69
Select Case rngCell(1, lngCol).Value
Case "A"
If i < 3 Then
If Len(rngCell(1, -1)) Then
i = i + 1
arr1st(i) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
Case "B"
If j < 4 Then
If Len(rngCell(1, -1)) Then
j = j + 1
arr2nd(j) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
Case "C"
If k < 4 Then
If Len(rngCell(1, -1)) Then
k = k + 1
arr3rd(k) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
End Select

Case Is 64
Select Case rngCell(1, lngCol).Value
Case "B"
If j < 4 Then
If Len(rngCell(1, -1)) Then
j = j + 1
arr2nd(j) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
Case "C"
If k < 4 Then
If Len(rngCell(1, -1)) Then
k = k + 1
arr3rd(k) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
End Select

Case Is 54
Select Case rngCell(1, lngCol).Value
Case "B"
If k < 4 Then
If Len(rngCell(1, -1)) Then
k = k + 1
arr3rd(k) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
End Select
End Select
Next 'rngcell

'Do it again if all arrays are not filled.
If i < 3 Or j < 4 Or k < 4 Then
lngCol = lngCol + 1
GoTo StartOver
End If

Range("B20:D20").Value = arr1st()
Range("B21:E21").Value = arr2nd()
Range("B22:E22").Value = arr3rd()
Range("A20").Value = "A"
Range("A21").Value = "B"
Range("A22").Value = "C"

Set rngCell = Nothing
Set rngPointList = Nothing
End Sub
'-------------------------------------------------



"J_J" wrote in message
...
Hi Jim,
Thank you for your interest. Although made the corrections somehow I am
not
able to get any logical results from your code. Maybe I am using a
different
region or set then the example you have provided. Can you supply a
working
example of a similar situation?.
Regards
J_J