Hi,

The below code workes perfectly for distributing students to 6 Depts with
referance to their entrance exam points (on column B) and according to their
1st, 2nd, 3th choices for the Depts (on column C, D,E) .

But when I try to increase the number of Depts thus the arrays to 9 by
adding

Dim arr7th() As String
Dim arr8th() As String
Dim arr9th() As String

Dim o As Long
Dim p As Long
Dim r As Long

ReDim arr7th(1 To 10) '..........
ReDim arr8th(1 To 10) '........
ReDim arr9th(1 To 10) '........

Plus adding loops for depts YAPI, MET and MOB with variables o, p, r such as

Case "YAPI"
If o < 10 Then 'YAPI
If Len(rngCell(1, -1)) Then
o = o + 1
arr6th(o) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "MET"
....
etc

change the if statement at the bottom part so that check for variables o, p,
r are also included.

and add

Range("B506:K506").Value = arr7th() ' YAPI
Range("B507:K507").Value = arr8th() ' MET
Range("B508:K508").Value = arr9th() ' MOB

to the bottom,

(so that depts 'YAPI', 'MET' and 'MOB' is also added)

OR

increase the number of students to be distributed to some depts to say 25, I
am getting a

Run-time error '1004':
Application-defined or object-defined error

with the
Select Case rngCell(1, IngCol).Value
line highlighted.

What am I missing here?.
Can experts here please correct my mistakes?

Here is the complete code that I need to increase the Dept. array number to
9 and capacity for each Depts. to 20.
I am including the whole code so that alterations can be made easily.

'---------------------------------------
Sub To_Depts()

Dim arr1st() As String
Dim arr2nd() As String
Dim arr3rd() As String
Dim arr4th() As String
Dim arr5th() As String
Dim arr6th() As String

Dim lngCol As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim q As Long


Dim rngCell As Excel.Range
Dim rngPointList As Excel.Range

Set rngPointList = Range("C5:C430")

lngCol = 2
ReDim arr1st(1 To 10) 'ELO
ReDim arr2nd(1 To 10) '
ReDim arr3rd(1 To 10) '
ReDim arr4th(1 To 10) '..........
ReDim arr5th(1 To 10) '........
ReDim arr6th(1 To 10) '...........

For q = 6 To 430
If Cells(q, "B").Text < "" Then _
Cells(q, "A").Value = "X"
Next


StartOver:
For Each rngCell In rngPointList
Select Case rngCell.Value
'----------------------------------------------
Case Is Range("L14").Value ' 69
Select Case rngCell(1, lngCol).Value

Case "ELO"
If i < 10 Then ' ELO
If Len(rngCell(1, -1)) Then
i = i + 1
arr1st(i) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "ELE"
If j < 10 Then 'ELE
If Len(rngCell(1, -1)) Then
j = j + 1
arr2nd(j) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "COMP"
If k < 10 Then 'COMP
If Len(rngCell(1, -1)) Then
k = k + 1
arr3rd(k) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "YTR"
If l < 10 Then 'YTR
If Len(rngCell(1, -1)) Then
l = l + 1
arr4th(l) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "MOT"
If m < 10 Then ' MOT
If Len(rngCell(1, -1)) Then
m = m + 1
arr5th(m) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "TES"
If n < 10 Then 'TES
If Len(rngCell(1, -1)) Then
n = n + 1
arr6th(n) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

End Select
'----------------------------------
Case Is Range("L16").Value '64
Select Case rngCell(1, lngCol).Value
Case "ELE"
If j < 10 Then 'ELE
If Len(rngCell(1, -1)) Then
j = j + 1
arr2nd(j) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If
Case "COMP"
If k < 10 Then 'COMP
If Len(rngCell(1, -1)) Then
k = k + 1
arr3rd(k) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "YTR"
If l < 10 Then 'YTR
If Len(rngCell(1, -1)) Then
l = l + 1
arr4th(l) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "MOT"
If m < 10 Then 'MOT
If Len(rngCell(1, -1)) Then
m = m + 1
arr5th(m) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "TES"
If n < 10 Then 'TES
If Len(rngCell(1, -1)) Then
n = n + 1
arr6th(n) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

End Select
'--------------------------------------------
Case Is Range("L15").Value '54
Select Case rngCell(1, lngCol).Value
Case "ELE"
If k < 10 Then 'ELE
If Len(rngCell(1, -1)) Then
k = k + 1
arr3rd(k) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "YTR"
If l < 10 Then 'YTR
If Len(rngCell(1, -1)) Then
l = l + 1
arr4th(l) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "MOT"
If m < 10 Then 'MOT
If Len(rngCell(1, -1)) Then
m = m + 1
arr5th(m) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "TES"
If n < 10 Then 'TES
If Len(rngCell(1, -1)) Then
n = n + 1
arr6th(n) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

End Select

'-------------------------------------
Case Is Range("L17").Value '50
Select Case rngCell(1, lngCol).Value
Case "YTR"
If l < 10 Then '
If Len(rngCell(1, -1)) Then
l = l + 1
arr4th(l) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "MOT"
If m < 10 Then '
If Len(rngCell(1, -1)) Then
m = m + 1
arr5th(m) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

Case "TES"
If n < 10 Then '
If Len(rngCell(1, -1)) Then
n = n + 1
arr6th(n) = rngCell(1, 0).Value
rngCell(1, -1).ClearContents
End If
End If

End Select
End Select
Next 'rngcell
'----------------------------------------
'
If i < 10 Or j < 10 Or k < 10 Or l < 10 Or m < 10 Or n < 10 Then '
lngCol = lngCol + 1
GoTo StartOver
End If

'--------------------------
Range("B500:K500").Value = arr1st() ' ELO
Range("B501:K501").Value = arr2nd() ' ELE
Range("B502:K502").Value = arr3rd() ' COMP
Range("B503:K503").Value = arr4th() ' YTR
Range("B504:K504").Value = arr5th() ' MOT
Range("B505:K505").Value = arr6th() ' TES

'--------------------
Range("A500").Value = "ELO" '
Range("A501").Value = "ELE" '
Range("A502").Value = "COMP" '
Range("A503").Value = "YTR" '
Range("A504").Value = "MOT" '
Range("A505").Value = "TES" '

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

Regards
J_J