Index of Minimum value in array

P

Paul Stevens

In a two dimensional array I want to find the position of
the minimum value in the first dimension and return the
value from the equivalent position in the second dimension.

My array is a VBA variable, not a range reference, and
it's values are not in any order. Ubound is several
thousand so I don't want to loop and for other reasons do
not want to sort. If necessary my two dim array could be
reconstructed as two complimentary single dim arrays.

I've been messing around with various worksheet functions
(incl .Min), but I'm fumbling!

TIA for any help,
Paul
 
C

Charles Williams

Hi Paul,

If you already have the data in a VBA array I think the fastest solution
would be a single pass loop: any other solution is going to have to read
each element at least once anyway.
I suspect that the additional overhead of using a worksheet function will
outweigh any speed gain you might get.

Charles
______________________
Decision Models
FastExcel Version 2 now available.
www.DecisionModels.com
 
P

Paul Stevens

Hi Charles,

Thanks for stopping me going down a blind alley.
Following your advice, to get value in 2nd dim from
minimum in 1st dim I'm now doing this

MinVal = 1 'known maximum possible value
For i = 0 To UBound(myArray)
If MinVal > myArray(i, 0) Then
MinVal = myArray(i, 0)
MinIndex = i
End If
Next
Result = myArray(MinIndex, 1)

Unfortunately I need to return values in the 2nd dim'
corresponding with the 10 smallest values in the 1st dim'.
Looping with .Small seemed ideal as a starter but no
direct way to get offset values without looping the entire
array. Didn't mention this earlier as I thought possible
without looping and the principle would be the same.
Never mind, I'll work with your suggested approach.

Thanks again,
Paul
 
D

Dana DeLouis

I'm not sure, but would any ideas here help you. I made a 2-dim array
quickly from a worksheet. There might be a faster way, but unsorted data
makes it a little harder.

Sub Demo()
'// Dana DeLouis
Dim v, MinLeft, ValueRight
v = [A1:B20]

With WorksheetFunction
MinLeft = .Min(.Index(v, 0, 1))
ValueRight = .Index(v, .Match(MinLeft, .Index(v, 0, 1), 0), 2)
End With
End Sub
 
D

Dana DeLouis

Did you say "Looping?" ;>) <vbg>

Don't know if this is what you want. In a 2-dim array, this should return
an array of the 10 smallest numbers in the first column.

Sub Demo()
'// Dana DeLouis
Dim v, TenSmallest
v = [A1:B20]
With WorksheetFunction
ActiveWorkbook.Names.Add "v_", .Transpose(.Index(v, 0, 1))
End With
TenSmallest = [TRANSPOSE(TRANSPOSE(SMALL(v_,{1,2,3,4,5,6,7,8,9,10})))]
ActiveWorkbook.Names("v_").Delete
End Sub
 
P

Paul Stevens

Dana,

Very interesting, you've come up with what I had been
struggling to find.

In my reply to Charles I mentioned my additional "smallest
10 values problem", I've adapted your code:

Sub Demo2()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight, i
v = [A1:B20] 'populated with =RAND(), then
'pastespecial/values back
For i = 1 To 10
With WorksheetFunction
MinLeft = .Small(.Index(v, 0, 1), i)
ValueRight = .Index(v, .Match(MinLeft, _
.Index(v, 0, 1), 0), 2)
End With

Cells(i, 3) = MinLeft
Cells(i, 4) = ValueRight
Next
'sort A1:B20 with colA and compare C1:D10 !
End Sub

Since working with Charles' single loop approach I've been
surprised to find it's faster than I expected. I'll
experiment using both methods with real life data, oh to
be spoilt with choice!

Many thanks,
Paul
-----Original Message-----
I'm not sure, but would any ideas here help you. I made a 2-dim array
quickly from a worksheet. There might be a faster way, but unsorted data
makes it a little harder.

Sub Demo()
'// Dana DeLouis
Dim v, MinLeft, ValueRight
v = [A1:B20]

With WorksheetFunction
MinLeft = .Min(.Index(v, 0, 1))
ValueRight = .Index(v, .Match(MinLeft, .Index(v, 0, 1), 0), 2)
End With
End Sub


--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


In a two dimensional array I want to find the position of
the minimum value in the first dimension and return the
value from the equivalent position in the second dimension.

My array is a VBA variable, not a range reference, and
it's values are not in any order. Ubound is several
thousand so I don't want to loop and for other reasons do
not want to sort. If necessary my two dim array could be
reconstructed as two complimentary single dim arrays.

I've been messing around with various worksheet functions
(incl .Min), but I'm fumbling!

TIA for any help,
Paul


.
 
D

Dana DeLouis

Hi Paul. Since you are looping, the same first Column array gets extracted
over and over. Perhaps you can extract that from the loop. Perhaps
something like this...

Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long

'Small test data
[A1:B20].Formula = "=RANDBETWEEN(1,100)"
[A1:B20] = [A1:B20].Value
v = [A1:B20]

With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft, Column1, 0), 2)
Cells(i, 3).Resize(1, 2) = Array(MinLeft, ValueRight)
Next i
End With
End Sub

(I have the ATP installed for RANDBETWEEN( ) to work.)

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Paul Stevens said:
Dana,

Very interesting, you've come up with what I had been
struggling to find.

In my reply to Charles I mentioned my additional "smallest
10 values problem", I've adapted your code:

Sub Demo2()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight, i
v = [A1:B20] 'populated with =RAND(), then
'pastespecial/values back
For i = 1 To 10
With WorksheetFunction
MinLeft = .Small(.Index(v, 0, 1), i)
ValueRight = .Index(v, .Match(MinLeft, _
.Index(v, 0, 1), 0), 2)
End With

Cells(i, 3) = MinLeft
Cells(i, 4) = ValueRight
Next
'sort A1:B20 with colA and compare C1:D10 !
End Sub

Since working with Charles' single loop approach I've been
surprised to find it's faster than I expected. I'll
experiment using both methods with real life data, oh to
be spoilt with choice!

Many thanks,
Paul
-----Original Message-----
I'm not sure, but would any ideas here help you. I made a 2-dim array
quickly from a worksheet. There might be a faster way, but unsorted data
makes it a little harder.

Sub Demo()
'// Dana DeLouis
Dim v, MinLeft, ValueRight
v = [A1:B20]

With WorksheetFunction
MinLeft = .Min(.Index(v, 0, 1))
ValueRight = .Index(v, .Match(MinLeft, .Index(v, 0, 1), 0), 2)
End With
End Sub


--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


In a two dimensional array I want to find the position of
the minimum value in the first dimension and return the
value from the equivalent position in the second dimension.

My array is a VBA variable, not a range reference, and
it's values are not in any order. Ubound is several
thousand so I don't want to loop and for other reasons do
not want to sort. If necessary my two dim array could be
reconstructed as two complimentary single dim arrays.

I've been messing around with various worksheet functions
(incl .Min), but I'm fumbling!

TIA for any help,
Paul


.
 
P

Paul Stevens

Hi Dana,

Wow! I would never have thought of that!!

This appears to extract the 10 smallest values in order
from the 1st column of v(), rather than the corresponding
values from the second as I need (but I think solved with
your first suggestion as adapted).

However I already have another good use for this as is.

Thanks again,
Paul

PS Your 2nd message (ie this) came in subsequent to my
reply to your first, despite posting times indicating
otherwise.
-----Original Message-----
Did you say "Looping?" ;>) <vbg>

Don't know if this is what you want. In a 2-dim array, this should return
an array of the 10 smallest numbers in the first column.

Sub Demo()
'// Dana DeLouis
Dim v, TenSmallest
v = [A1:B20]
With WorksheetFunction
ActiveWorkbook.Names.Add "v_", .Transpose(.Index (v, 0, 1))
End With
TenSmallest = [TRANSPOSE(TRANSPOSE(SMALL(v_, {1,2,3,4,5,6,7,8,9,10})))]
ActiveWorkbook.Names("v_").Delete
End Sub

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Hi Charles,

Thanks for stopping me going down a blind alley.
Following your advice, to get value in 2nd dim from
minimum in 1st dim I'm now doing this

MinVal = 1 'known maximum possible value
For i = 0 To UBound(myArray)
If MinVal > myArray(i, 0) Then
MinVal = myArray(i, 0)
MinIndex = i
End If
Next
Result = myArray(MinIndex, 1)

Unfortunately I need to return values in the 2nd dim'
corresponding with the 10 smallest values in the 1st dim'.
Looping with .Small seemed ideal as a starter but no
direct way to get offset values without looping the entire
array. Didn't mention this earlier as I thought possible
without looping and the principle would be the same.
Never mind, I'll work with your suggested approach.

Thanks again,
Paul
going
to have to read position
of reasons
do could
be


.
 
A

Alan Beban

If the functions in the freely downloadable file at
http://home.pacbell.net/beban are available to your workbook, the
following will load the 1-D arrOutput with the values from the second
"column" of myArray corresponding to the 10 smallest values in the first
"column" of myArray:

Dim arrOutput(1 To 10)
For i = 1 To 10
arrOutput(i) = _
VLookups(Application.Small(Application.Index(MyArray, 0, 1), i), _
MyArray, 2)(1, 1)
Next

Alan Beban
 
P

Paul Stevens

Hi Dana,

Yes indeed, why didn't I think of that.
I've tested with larger volumes of data and Demo3 has
close to a 2:1 speed advantage, about 58% of Demo2 time
and well worth gaining.

I've pre-filled A1:B5000 with random data:

Sub demo3Pre()
Dim i As Long
For i = 1 To 5000
Cells(i, 1) = Rnd
Cells(i, 2) = Rnd
Next
End Sub

In the Demo subs I've encountering a problem with volumes
over 2730

v = [A1:B5000] 'no error
msgbox v(2730,0,1) ' no error
msgbox v(2731,0,1) ' error #9, cell values look OK

I have no idea of the significance of >2730 with this
range to array method. My real array is not populated this
way so the method works fine with larger volumes. However
I am curious about this 2730 limit.

Thanks (yet) again,
Paul
-----Original Message-----
Hi Paul. Since you are looping, the same first Column array gets extracted
over and over. Perhaps you can extract that from the loop. Perhaps
something like this...

Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long

'Small test data
[A1:B20].Formula = "=RANDBETWEEN(1,100)"
[A1:B20] = [A1:B20].Value
v = [A1:B20]

With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft, Column1, 0), 2)
Cells(i, 3).Resize(1, 2) = Array(MinLeft, ValueRight)
Next i
End With
End Sub

(I have the ATP installed for RANDBETWEEN( ) to work.)

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Dana,

Very interesting, you've come up with what I had been
struggling to find.

In my reply to Charles I mentioned my additional "smallest
10 values problem", I've adapted your code:

Sub Demo2()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight, i
v = [A1:B20] 'populated with =RAND(), then
'pastespecial/values back
For i = 1 To 10
With WorksheetFunction
MinLeft = .Small(.Index(v, 0, 1), i)
ValueRight = .Index(v, .Match(MinLeft, _
.Index(v, 0, 1), 0), 2)
End With

Cells(i, 3) = MinLeft
Cells(i, 4) = ValueRight
Next
'sort A1:B20 with colA and compare C1:D10 !
End Sub

Since working with Charles' single loop approach I've been
surprised to find it's faster than I expected. I'll
experiment using both methods with real life data, oh to
be spoilt with choice!

Many thanks,
Paul
-----Original Message-----
I'm not sure, but would any ideas here help you. I
made
a 2-dim array
quickly from a worksheet. There might be a faster way, but unsorted data
makes it a little harder.

Sub Demo()
'// Dana DeLouis
Dim v, MinLeft, ValueRight
v = [A1:B20]

With WorksheetFunction
MinLeft = .Min(.Index(v, 0, 1))
ValueRight = .Index(v, .Match(MinLeft, .Index
(v,
0, 1), 0), 2)
End With
End Sub


--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


In a two dimensional array I want to find the
position
of
the minimum value in the first dimension and return the
value from the equivalent position in the second dimension.

My array is a VBA variable, not a range reference, and
it's values are not in any order. Ubound is several
thousand so I don't want to loop and for other
reasons
do
not want to sort. If necessary my two dim array
could
be
reconstructed as two complimentary single dim arrays.

I've been messing around with various worksheet functions
(incl .Min), but I'm fumbling!

TIA for any help,
Paul


.


.
 
D

Dana DeLouis

Hi Paul. My guess is that you are using an earlier version of Excel. They
were limited in their ability to do array work. Here is one article...

XL7: Array Formulas Return #NUM! Error Value
http://support.microsoft.com/default.aspx?scid=kb;en-us;132221&Product=xlw

it says in part..."This behavior occurs because in Microsoft Excel, the
maximum array size is 5458 elements "

Therefore, 5458 / 2 = 2729. A number like 2730 will therefore give you the
error you describe. This problem was fixed (and enhanced) in later
versions.

HTH.
--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Paul Stevens said:
Hi Dana,

Yes indeed, why didn't I think of that.
I've tested with larger volumes of data and Demo3 has
close to a 2:1 speed advantage, about 58% of Demo2 time
and well worth gaining.

I've pre-filled A1:B5000 with random data:

Sub demo3Pre()
Dim i As Long
For i = 1 To 5000
Cells(i, 1) = Rnd
Cells(i, 2) = Rnd
Next
End Sub

In the Demo subs I've encountering a problem with volumes
over 2730

v = [A1:B5000] 'no error
msgbox v(2730,0,1) ' no error
msgbox v(2731,0,1) ' error #9, cell values look OK

I have no idea of the significance of >2730 with this
range to array method. My real array is not populated this
way so the method works fine with larger volumes. However
I am curious about this 2730 limit.

Thanks (yet) again,
Paul
-----Original Message-----
Hi Paul. Since you are looping, the same first Column array gets extracted
over and over. Perhaps you can extract that from the loop. Perhaps
something like this...

Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long

'Small test data
[A1:B20].Formula = "=RANDBETWEEN(1,100)"
[A1:B20] = [A1:B20].Value
v = [A1:B20]

With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft, Column1, 0), 2)
Cells(i, 3).Resize(1, 2) = Array(MinLeft, ValueRight)
Next i
End With
End Sub

(I have the ATP installed for RANDBETWEEN( ) to work.)

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Dana,

Very interesting, you've come up with what I had been
struggling to find.

In my reply to Charles I mentioned my additional "smallest
10 values problem", I've adapted your code:

Sub Demo2()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight, i
v = [A1:B20] 'populated with =RAND(), then
'pastespecial/values back
For i = 1 To 10
With WorksheetFunction
MinLeft = .Small(.Index(v, 0, 1), i)
ValueRight = .Index(v, .Match(MinLeft, _
.Index(v, 0, 1), 0), 2)
End With

Cells(i, 3) = MinLeft
Cells(i, 4) = ValueRight
Next
'sort A1:B20 with colA and compare C1:D10 !
End Sub

Since working with Charles' single loop approach I've been
surprised to find it's faster than I expected. I'll
experiment using both methods with real life data, oh to
be spoilt with choice!

Many thanks,
Paul

-----Original Message-----
I'm not sure, but would any ideas here help you. I made
a 2-dim array
quickly from a worksheet. There might be a faster way,
but unsorted data
makes it a little harder.

Sub Demo()
'// Dana DeLouis
Dim v, MinLeft, ValueRight
v = [A1:B20]

With WorksheetFunction
MinLeft = .Min(.Index(v, 0, 1))
ValueRight = .Index(v, .Match(MinLeft, .Index (v,
0, 1), 0), 2)
End With
End Sub


--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


"Paul Stevens" <[email protected]>
wrote in message
In a two dimensional array I want to find the position
of
the minimum value in the first dimension and return the
value from the equivalent position in the second
dimension.

My array is a VBA variable, not a range reference, and
it's values are not in any order. Ubound is several
thousand so I don't want to loop and for other reasons
do
not want to sort. If necessary my two dim array could
be
reconstructed as two complimentary single dim arrays.

I've been messing around with various worksheet
functions
(incl .Min), but I'm fumbling!

TIA for any help,
Paul


.


.
 
P

Paul Stevens

Hi Dana,

I'm using Excel97 / XL8. Old but not as old as XL7 as
referred to in the KB article, I can't yet find anything
similar relating to XL8.

I was a bit misleading in the way I reported the error.
Maximum array elements appears limited only by normal xl
constraints and memory, can be populated in a variety of
ways and can be dumped into cells by looping, several 10's
of k's of data no problem.

However in your demo subs following fails (no doubt some
other operations will fail also):
= .Index(myarray, 0, 1)
if there are more than 5461 in an array of one column,
2730 in each of two columns, 1365 in four, etc. So the
absolute limit in my XL8 appears to be 5461, remarkably
close to 5458 as reported for XL7.

I need to get to the bottom of this for other reasons and
will look into it more next week. However if in the
meantime you or anyone can shed any more light I would be
very grateful.

Regards,
Paul
-----Original Message-----
Hi Paul. My guess is that you are using an earlier version of Excel. They
were limited in their ability to do array work. Here is one article...

XL7: Array Formulas Return #NUM! Error Value
http://support.microsoft.com/default.aspx?scid=kb;en- us;132221&Product=xlw

it says in part..."This behavior occurs because in Microsoft Excel, the
maximum array size is 5458 elements "

Therefore, 5458 / 2 = 2729. A number like 2730 will therefore give you the
error you describe. This problem was fixed (and enhanced) in later
versions.

HTH.
--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Hi Dana,

Yes indeed, why didn't I think of that.
I've tested with larger volumes of data and Demo3 has
close to a 2:1 speed advantage, about 58% of Demo2 time
and well worth gaining.

I've pre-filled A1:B5000 with random data:

Sub demo3Pre()
Dim i As Long
For i = 1 To 5000
Cells(i, 1) = Rnd
Cells(i, 2) = Rnd
Next
End Sub

In the Demo subs I've encountering a problem with volumes
over 2730

v = [A1:B5000] 'no error
msgbox v(2730,0,1) ' no error
msgbox v(2731,0,1) ' error #9, cell values look OK

I have no idea of the significance of >2730 with this
range to array method. My real array is not populated this
way so the method works fine with larger volumes. However
I am curious about this 2730 limit.

Thanks (yet) again,
Paul
-----Original Message-----
Hi Paul. Since you are looping, the same first Column array gets extracted
over and over. Perhaps you can extract that from the loop. Perhaps
something like this...

Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long

'Small test data
[A1:B20].Formula = "=RANDBETWEEN(1,100)"
[A1:B20] = [A1:B20].Value
v = [A1:B20]

With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft, Column1, 0), 2)
Cells(i, 3).Resize(1, 2) = Array(MinLeft, ValueRight)
Next i
End With
End Sub

(I have the ATP installed for RANDBETWEEN( ) to work.)
<snip>
 
D

Dana DeLouis

Hi Paul. The 5461 is the "Other" limit for Excel 97. Here is a link...

XL: Limitations of Passing Arrays to Excel Using Automation
http://support.microsoft.com/default.aspx?kbid=177991

It says in part...

"The maximum number of elements in the array is limited by available memory
or the Excel worksheet maximum size (65536 rows X 256 columns). However, the
maximum number of elements in the array that you can pass to Excel using the
Excel Transpose function is 5461. If you exceed this limit, you receive the
following error message: "

I don't know why it only mentions "Transpose." It fails on other things as
well.
HTH.

--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =


Paul Stevens said:
Hi Dana,

I'm using Excel97 / XL8. Old but not as old as XL7 as
referred to in the KB article, I can't yet find anything
similar relating to XL8.

I was a bit misleading in the way I reported the error.
Maximum array elements appears limited only by normal xl
constraints and memory, can be populated in a variety of
ways and can be dumped into cells by looping, several 10's
of k's of data no problem.

However in your demo subs following fails (no doubt some
other operations will fail also):
= .Index(myarray, 0, 1)
if there are more than 5461 in an array of one column,
2730 in each of two columns, 1365 in four, etc. So the
absolute limit in my XL8 appears to be 5461, remarkably
close to 5458 as reported for XL7.

I need to get to the bottom of this for other reasons and
will look into it more next week. However if in the
meantime you or anyone can shed any more light I would be
very grateful.

Regards,
Paul

<snip>
 
P

Paul Stevens

Hi Dana

Thanks for digging this out. Inconvenient but I'm pleased
to have discovered now rather than later.

If I understand KB177991 correctly, the limitations appear
the same in XL97 and XL2000. Or, regarding the 5461 limit
(footnote F), perhaps it's only the Transpose function
that is a problem in XL2000 but there are others such as I
described in XL97, anyone know!

I assume, although not yet tried, I could use two single
column arrays and adapt your code accordingly, and extend
my current limit from 2730 to say 5461.

Regards,
Paul
 
C

Charles Williams

Hi Paul & Dana,

Dana's solution is very elegant but looping seems to be much faster on my
system using Excel97 :

Demo3 takes about 48 milliseconds on my system for 2500 rows.

The looping solution below takes about 1.6 millisecs for 2500 rows (and does
not have the 5468 array function limit), and its pretty much linear with the
number of rows (10000 rows takes about 5.6 millisecs)

Option Explicit
Option Base 1
Private Declare Function getFrequency Lib "kernel32" Alias
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
Public Function MicroTimer() As Double
Dim cyTicks1 As Currency
Static cyFrequency As Currency
10 MicroTimer = 0
20 If cyFrequency = 0 Then getFrequency cyFrequency
30 getTickCount cyTicks1
40 If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Sub FindSmallest()
Dim vArr As Variant
Dim iLargeIX As Long
Dim dSmallNums() As Double
Dim iSmallIX() As Long
Dim j As Long
Dim dAnsa() As Double
Dim dtime As Double
Dim nSmalls As Long
Dim nRows As Long

nSmalls = 10
nRows = 2500

vArr = Worksheets("Sheet1").Range("a1").Resize(nRows, 2)
ReDim dSmallNums(nSmalls) As Double
ReDim iSmallIX(nSmalls) As Long
ReDim dAnsa(nSmalls) As Double
dtime = MicroTimer()
For j = 1 To nSmalls
dSmallNums(j) = vArr(j, 1)
iSmallIX(j) = j
Next j

iLargeIX = FindLargest(dSmallNums)

For j = nSmalls + 1 To nRows
If vArr(j, 1) < dSmallNums(iLargeIX) Then
dSmallNums(iLargeIX) = vArr(j, 1)
iSmallIX(iLargeIX) = j
iLargeIX = FindLargest(dSmallNums)
End If
Next j

For j = 1 To nSmalls
dAnsa(j) = vArr(iSmallIX(j), 2)
Next j

dtime = MicroTimer() - dtime
MsgBox dtime * 1000 & " Millisecs"
End Sub

Function FindLargest(dSmallNums() As Double) As Long
Dim j As Long
Dim dLarge As Double
dLarge = dSmallNums(1)
FindLargest = 1
For j = 2 To UBound(dSmallNums)
If dSmallNums(j) > dLarge Then
FindLargest = j
dLarge = dSmallNums(j)
End If
Next j
End Function

Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long
Dim dtime As Double

v = [A1:B2500]

dtime = MicroTimer()
With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft, Column1, 0), 2)
'Cells(i, 3).Resize(1, 2) = Array(MinLeft, ValueRight)
Next i
End With
dtime = MicroTimer() - dtime
MsgBox dtime * 1000 & " Millisecs"
End Sub

Charles
______________________
Decision Models
FastExcel Version 2 now available.
www.DecisionModels.com
 
P

Paul Stevens

Hi Charles,

That's blinding!

I had not forgotten your original comments re speed and
loop vs function overheads. I had established that looping
was faster for a single operation such as simply getting
the minimum. But I was way off finding an efficient loop
to get the ten smallest, such as you have just
demonstrated.

Part of your trick, I think, is that "FindLargest" is only
called about 50 times with 2500 rows, and just slightly
more with 10000 (I added a counter). If anything your code
should be relatively quicker with increasing qantities.

I just need to sort the ten smallest before returning
relative values from the 2nd column, adding to the last
part of your code:

For j = 1 To nSmalls
' dAnsa(j) = vArr(iSmallIX(j), 2)
Cells(j, 3).Resize(1, 2) = _
Array(vArr(iSmallIX(j), 1), iSmallIX(j))
Next

Range("C1").Resize(nSmalls, 2).Sort Key1:=Range("C1")

For j = 1 To nSmalls
dAnsa(j) = vArr(Cells(j, 4), 2)
'iSmallIX(j) = Cells(j, 4)
'Cells(j, 6) = dAnsa(j)
'Cells(j, 5) = vArr(iSmallIX(j), 1)
Next

A sixth sense tells me you wouldn't do it this way, but
it's only 10x2!

Where speed and/or quantity are issues, not to mention the
5461 element limit with functions in XL97 (perhaps also
XL2000?), your results and methods are conclusive.

I still like Dana's neat and lean Index and Match method,
which I will use where these issues are not relevant.

With both your help I've learnt a lot about handling
arrays over the last few days.

Thank you very much,
Paul
-----Original Message-----
Hi Paul & Dana,

Dana's solution is very elegant but looping seems to be much faster on my
system using Excel97 :

Demo3 takes about 48 milliseconds on my system for 2500 rows.

The looping solution below takes about 1.6 millisecs for 2500 rows (and does
not have the 5468 array function limit), and its pretty much linear with the
number of rows (10000 rows takes about 5.6 millisecs)

Option Explicit
Option Base 1
Private Declare Function getFrequency Lib "kernel32" Alias
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
Public Function MicroTimer() As Double
Dim cyTicks1 As Currency
Static cyFrequency As Currency
10 MicroTimer = 0
20 If cyFrequency = 0 Then getFrequency cyFrequency
30 getTickCount cyTicks1
40 If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Sub FindSmallest()
Dim vArr As Variant
Dim iLargeIX As Long
Dim dSmallNums() As Double
Dim iSmallIX() As Long
Dim j As Long
Dim dAnsa() As Double
Dim dtime As Double
Dim nSmalls As Long
Dim nRows As Long

nSmalls = 10
nRows = 2500

vArr = Worksheets("Sheet1").Range("a1").Resize(nRows, 2)
ReDim dSmallNums(nSmalls) As Double
ReDim iSmallIX(nSmalls) As Long
ReDim dAnsa(nSmalls) As Double
dtime = MicroTimer()
For j = 1 To nSmalls
dSmallNums(j) = vArr(j, 1)
iSmallIX(j) = j
Next j

iLargeIX = FindLargest(dSmallNums)

For j = nSmalls + 1 To nRows
If vArr(j, 1) < dSmallNums(iLargeIX) Then
dSmallNums(iLargeIX) = vArr(j, 1)
iSmallIX(iLargeIX) = j
iLargeIX = FindLargest(dSmallNums)
End If
Next j

For j = 1 To nSmalls
dAnsa(j) = vArr(iSmallIX(j), 2)
Next j

dtime = MicroTimer() - dtime
MsgBox dtime * 1000 & " Millisecs"
End Sub

Function FindLargest(dSmallNums() As Double) As Long
Dim j As Long
Dim dLarge As Double
dLarge = dSmallNums(1)
FindLargest = 1
For j = 2 To UBound(dSmallNums)
If dSmallNums(j) > dLarge Then
FindLargest = j
dLarge = dSmallNums(j)
End If
Next j
End Function

Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long
Dim dtime As Double

v = [A1:B2500]

dtime = MicroTimer()
With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft, Column1, 0), 2)
'Cells(i, 3).Resize(1, 2) = Array(MinLeft, ValueRight)
Next i
End With
dtime = MicroTimer() - dtime
MsgBox dtime * 1000 & " Millisecs"
End Sub

Charles
______________________
Decision Models
FastExcel Version 2 now available.
www.DecisionModels.com
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top