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?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Leigh PurvisConnect With a Mentor Database 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
 
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
 
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
All Courses

From novice to tech pro — start learning today.