ExcelBanter - Still Having Application.Match trouble

wrote:
Unfortunately, its highly likely that my arrays will be longer than
there are rows in Excel. I think I'm going to have to find an
alternative method here to accomplish what I was trying to accomplish -
probably an entirely different approach.

Attached is some code that "converts" a 6000-element vertical array into
three 2000-element arrays and extracts lower and upper bounds for
particular occurrences of the specified values. It's quick and dirty,
but perhaps it could be adapted to convert a 2.4M-element array into
forty 60,000-element arrays to accomplish your purposes. It depends on
the availability to your workbook of the functions in the freely
downloadable file at http://home.pacbell.net/beban. No representations
on execution time, but since you have been talking about 5-hour+
execution times, perhaps it could be useful. Watch for word wrap.

Sub Test12345()
Dim a1, a2, a3
Dim ws8 As Worksheet, ws9 As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim i As Long, lb As Long, ub As Long
Dim z1 As Long, z2 As Long

Set ws9 = Worksheets(9)
Set rng2 = ws9.Range("A1:B6000")
Set rngD = Range("d1:d" & rng2(6000, 1).Value)
For q = 1 To rng2(6000, 1).Value
rngD(q).Value = CStr(q)
Next
a1 = rngD
a2 = rng2
a3 = ColumnVector(a2, 1)
'Up to this point it's just been loading a1 and a2 and
'extracting the column vector; from here on you just
'break the arrays into chunks, select an available worksheet
'and extract the relevant bounds on that worksheet

'starttime = Now()

'This first loop adjusts the first chunk
For i = 2000 To 10000
If a3(i, 1) < a3(i + 1, 1) Then
lim1 = i
Exit For
End If
Next

'This second loop adjusts the second chunk
For i = 4000 To 10000
If a3(i, 1) < a3(i + 1, 1) Then
lim2 = i
Exit For
End If
Next

a5 = SubArray(a3, 1, 1, lim2 + 1, 6000) 'Third chunk
a4 = SubArray(a3, 1, 1, lim1 + 1, lim2) 'Second chunk
ResizeArray a3, lim1, 1 'First chunk

'Pick a worksheet
Set ws8 = Worksheets(8)

'Set up the ranges to hold the 3 chunks and the output
Set rng6 = ws8.Range("k1:j" & UBound(a1, 1))
Set rng3 = ws8.Range("a1:a" & lim1)
Set rng4 = ws8.Range("b1:b" & lim2 - lim1)
Set rng5 = ws8.Range("c1:c" & 6000 - lim2)

'Transfer the chunks to the respective worksheet ranges
rng3.Value = a3
rng4.Value = a4
rng5.Value = a5

'Set the limits for looping on each chunks except the last
z1 = rng3(lim1, 1).Value
z2 = rng4(lim2 - lim1, 1).Value

'Loop each chunk
For i = 1 To z1
rng6(i, 1).Formula = "=MATCH(" & a1(i, 1) & "," & rng3.Address & ",0)"
rng6(i, 2).Formula = "=MATCH(" & a1(i, 1) & ", " & rng3.Address & ")"
lb = rng6(i, 1).Value
ub = rng6(i, 2).Value
'Debug.Print i, lb, ub
Next
For i = z1 + 1 To z2
rng6(i, 1).Formula = "=" & lim1 & "+MATCH(" & a1(i, 1) & "," &
rng4.Address & ",0)"
rng6(i, 2).Formula = "=" & lim1 & "+MATCH(" & a1(i, 1) & ", " &
rng4.Address & ")"
lb = rng6(i, 1).Value
ub = rng6(i, 2).Value
'Debug.Print i, lb, ub
If rng6(i, 1).Value = lim2 - 3 Then Exit For
Next
For i = z2 + 1 To UBound(a1, 1)
rng6(i, 1).Formula = "=" & lim2 & "+MATCH(" & a1(i, 1) & "," &
rng5.Address & ",0)"
rng6(i, 2).Formula = "=" & lim2 & "+MATCH(" & a1(i, 1) & ", " &
rng5.Address & ")"
lb = rng6(i, 1).Value
ub = rng6(i, 2).Value
'Debug.Print i, lb, ub
Next

'Debug.Print (Now() - starttime) * 86400
End Sub

Alan Beban