Array subscript error # 9 our of range....Quicksort routine

Access 2003
vba

In the routine below  QuicksortD

getting an error on this line
M = ary(Int((LB + UB) / 2), ref) '  error #9  subscript out of range error here


The Upper bound seems to stay fixed at 27...



See previous thread
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_23136149.html#discussion

Thanks
fordraiders




Do Until rsSql.EOF  ' query loop
 
<code>
 
 
'START BUILDING ARRAY FROM SQL
ReDim Preserve intArrayX(27, 1 To rsSql.RecordCount)
u = u + 1
' start to add values to the array
intArrayX(0, u) = rsSql.Fields(0).Value ' Item-Grainger Sku
'intArrayX (1,u)= rssql.Fields(1).Value ' NOUNPHRS1
'intArrayX (2,u)= rssql.Fields(2).Value ' NOUNPHRS2
'intArrayX (3,u)= rssql.Fields(3).Value ' NOUNPHR3
intArrayX(4, u) = rsSql.Fields(4).Value ' RichText
'intArrayX(5,u) = "(found: " & wdFound & " )" ' wdfound nouns
intArrayX(6, u) = score 'rsSql.Fields(6).Value 'score ' SORTED BY Desc  score
intArrayX(7, u) = rsSql.Fields(7).Value ' COUNT FROM RANKLIST2 ...sorted by desc count
intArrayX(8, u) = rsCust.Fields("fldDid").Value
intArrayX(9, u) = rsSql.Fields(9).Value ' WWGMFRNUM
intArrayX(10, u) = rsSql.Fields(10).Value ' WWGMFGNAME
intArrayX(11, u) = rsSql.Fields(11).Value '  DESC
intArrayX(12, u) = rsSql.Fields(12).Value ' COMMENTS
intArrayX(13, u) = rsSql.Fields(13).Value ' REDBOOKNUM
intArrayX(14, u) = rsSql.Fields(14).Value ' XREF
intArrayX(15, u) = rsSql.Fields(15).Value ' SPIN
intArrayX(16, u) = rsSql.Fields(16).Value ' UOM
intArrayX(17, u) = rsSql.Fields(17).Value ' UOM QTY
intArrayX(18, u) = rsSql.Fields(18).Value ' SHIP
intArrayX(19, u) = rsSql.Fields(19).Value ' SHIP QTY
intArrayX(20, u) = rsSql.Fields(20).Value ' ALT1
intArrayX(21, u) = rsCust.Fields("fldMfgname").Value
    intArrayX(22, u) = rsCust.Fields("fldMfgnameOrig").Value
     intArrayX(23, u) = rsCust.Fields("fldMfrnum").Value
   intArrayX(24, u) = rsCust.Fields("fldMfrnumOrig").Value
  intArrayX(25, u) = Trim(rsCust.Fields("fldDescription").Value)
intArrayX(26, u) = rsCust.Fields("fldDescriptionOrig").Value
'If Numeric....
'    intArray(u, 27) = Format$(rsSql.Fields(6).Value, "00000000") & Format$(intArrayX(u, 7) = rsSql.Fields(7).Value, "00000000")
    intArrayX(27, u) = Format$(score, "00000000") & Format$(intArrayX(7, u) = rsSql.Fields(7).Value, "00000000")
 
'    If Not Numeric...
'    intArray(u, 27) = UCase(rsSql2.Fields(6).Value) & ";" & UCase(intArrayX(u, 7) = rsSql2.Fields(7).Value)
                score = 0
             '   nf1 = ""
                wdFound = ""
                ' ADDED 06/14/2007
                didfindstring = ""
                rsSql.MoveNext
            Loop
 
' sort the array...
QuicksortD intArrayX, LBound(intArrayX), UBound(intArrayX), 27
 
Sub QuicksortD(ary, LB, UB, ref) 
Dim M As Variant, temp 
Dim i As Long, ii As Long, iii As Integer 
i = UB 
ii = LB 
M = ary(Int((LB + UB) / 2), ref) '  error #9  subscript out of range error here
Do While ii <= i 
Do While ary(ii, ref) > M 
ii = ii + 1 
Loop 
Do While ary(i, ref) < M 
i = i - 1 
Loop 
If ii <= i Then 
For iii = LBound(ary, 2) To UBound(ary, 2) 
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii) 
ary(i, iii) = temp 
Next 
ii = ii + 1: i = i - 1 
End If 
Loop 
If LB < i Then QuicksortD ary, LB, i, ref 
If ii < UB Then QuicksortD ary, ii, UB, ref 
End Sub

Open in new window

LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LucasMS Dynamics DeveloperCommented:
Not sure if this might help but here is a link to a web page

http://www.cpearson.com/excel/VBAArrays.htm

Lots of array related stuff that might help you get around your problem another way just in case.
0
Leigh PurvisDatabase DeveloperCommented:
The array example you have is geared towards a 2D array of reversed dimensions than that with which you're working.
You need to change a few things...
Consider this alteration as a replacement version of the procedure:

Sub QuicksortJ(ary, LB, UB, ref)
    Dim M As Variant, temp
    Dim i As Long, ii As Long, iii As Integer
   
    i = UB
    ii = LB
    M = ary(ref, Int((LB + UB) / 2))
    Do While ii <= i
        Do While ary(ref, ii) > M
            ii = ii + 1
        Loop
        Do While ary(ref, i) < M
            i = i - 1
        Loop
        If ii <= i Then
            For iii = LBound(ary, 1) To UBound(ary, 1)
                temp = ary(iii, ii): ary(iii, ii) = ary(iii, i)
                ary(iii, i) = temp
            Next
            ii = ii + 1: i = i - 1
        End If
    Loop
    If LB < i Then QuicksortJ ary, LB, i, ref
    If ii < UB Then QuicksortJ ary, ii, UB, ref
End Sub

Which you'd call as
QuicksortJ intArrayX, LBound(intArrayX, 2), UBound(intArrayX, 2), 27
to select the bounds of the appropriate dimension.

(I still stand by what I said last time though :-p.  IMO recordsets make more sense.)
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
Lpurvis,
You all get no argument from me on recordsets...
Arrays are a new area for me.. I'am learning quite a bit and fast.

The possibilities to use arrays are in my future for other smaller projects..

The help from all of you is inValueable !  I understand where you are coming from, But I have tio explore other possibilties.

Thanks a million for the rewrite...!

Will test it soon.
0
FordraidersAuthor Commented:
Lpurvis, Worked Great...Got another problem ,   But will post another question...Almost completed !

0
Leigh PurvisDatabase DeveloperCommented:
All cool then.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.