Trouble increasing the array number and capacity?

[J_J]

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

 

[J_J]

Sorry for my mistake:
Column A is used for marking with "X" thus The names are in column B, exam
points in C, and 1st, 2nd and 3th coices are in columns D, E, F
respectively.
J_J

 

[Tom Ogilvy]

Near as I can tell the problem is you misspelled lngcol by using an "I"
instead of an "L"

Select Case rngCell(1, IngCol).Value

however, even if IngCol has a value of 0, it shouldn't raise an error:

set rngCell = Range("C10")
? rngCell(1,0).Address
$B$10

 

[J_J]

Hi Tom,
I wish that would have been the reason. But it ain't.
I typed it wrongly when I was typing the follow-up question here.
On the file "lngcol" is typed with an "L" not an "I".
I am stuck.
I am uploding the file to my website with the name "distribute.xls" Here is
the link:
http://www.eserceker.com/xls/distribute.xls
I' ll be more then happy if you or any expert interested here will give it a
try.
Sorry for the non-english language used in the file. But it is straight
forward. Only one button available on Sheet1 to execute all macros...
Sincerely
J_J

 

[Jim Cone]

J_J,

You have run out of columns.
RngCell is column C, so lngCol cannot exceed 254...
RngCell(1, 1) is Column 3
RngCell(1, 254) is Column 256

You might try something like this...
If i < 10 Or j < 10 Or k < 20 Or l < 10 Or m < 10 Or n < 10 Then
lngCol = lngCol + 1
If lngCol < 255 Then
GoTo StartOver
End If
End If

Regards,
Jim Cone
San Francisco, USA

 

[J_J]

Jim,
Thank you. You were correct. Now why didn't I think of that?.
Do you think if I increase the Department number from 6 to 9 as described
above and increase dept. capacities around 20 for most of them (which is the
real case) that doesn't introduce similar problems?
Regards
J_J

 

[Jim Cone]

J_J,

Yes, as you have only 125 students, but would have (9 * 20) 180 capacity.
You probably ought to exit when either all the students are assigned or
the column limit is reached.

Also, I strongly suggest you put Option Explicit at the top of each module.

In addition...
The "Sub SIRALA()" belongs in either module1 or module2, not the Sheet1 module.

Using Application.ScreenUpdating = False at the beginning of your code and
Application.ScreenUpdating = True at the end will speed things up a little.

Regards,
Jim Cone
San Francisco, USA

 

[Jim Cone]

J_J,

More comments...

I should also have recommended "Sub Doldur()" to be in a general module.

Also, check the point qualification limits, for example...
Case Is > Range("L17").Value '50
means the student must have a point value of 51 or more, not 50

Regards,
Jim Cone

 

[Tom Ogilvy]

Don't the choices stop after column F

so when lngcol achieves a value of 7, you have assigned all eligible
students I believe (choices are only through column F). You criteria now
continues on if any department is not filled up.

so your terminating condition should be:

If i < 10 Or j < 10 Or k < 10 Or l < 10 Or m < 10 Or n < 10 Then
lngCol = lngCol + 1
if lngCol < 7 then _
GoTo StartOver
End If

Jim suggested similar, but I don't believe it was as specific.

Increasing department numbers or department capacities should have no effect
if you add this condition.

 

[J_J]

Jim,
I did all the modifications you proposed and the applicaition works lot
better now.
You guys are great.
Thank you.
J_J

 

[J_J]

Tom,
Good point there. Yes I did the modification, increased the number of depts
and had no problems...
Thank you again for your help.
J_J

 

[J_J]

Jim,
Please forgive me keep asking endless follow-ups ...
But, is it possible to add students with the same points equal to last
distributed student point to the dept. lists?.
Regards
J_J

 

[J_J]

Tom,
Please forgive me keep asking endless follow-ups ...
But, is it possible to add students with the same points equal to last
distributed student point to the dept. lists?.
Regards
J_J

 

[Jim Cone]

J_J,

Huh?...
Not quite sure what you are after, but if you are trying to fill
up all classes, why not just lower the applicable point qualification
limit and run the code again.

Regards,
Jim Cone
San Francisco, USA

 

[J_J]

No, I am just trying to make sure that:
Say the capacity limit is 20 for a dept and 20 students have been selected
and the distributed to this dept. Say the student which managed to get into
this group has minimum points of 65.
If there are other students with the same point (65), no matter what the
capacity of that dept is, I want to make sure that thouse students are added
to the bottom of the group.
Something like this.
J_J

 

[Jim Cone]

J_J,

I understand now, but I don't have an approach for you right off.
Maybe Tom Ogilvy will have some ideas.

Regards,
Jim Cone

 

[J_J]

Thank you Jim,

I need to correct a mistake with my previous post with a sentence...

the sentence:
"If there are other students with the same point (65), no matter what the
capacity of that dept is, I want to make sure that thouse students are added
to the bottom of the group."

should have been:
"If there are other students with the same point (65) (and have their
1stchoice, or 2ndchoice or 3thchoice with the same dept), no matter what the
capacity of that dept is, I want to make sure that thouse students are added
to the bottom of the group."

Hope Tom will come up with a solution suggestion.
Sincerely
J_J