I wanted to apply a filter to a large range of data, to select the top ten values in a column.
But I don't want to re-arrange the data, just to filter the rows with the top ten values.
I was thinking of using a sort function for 2D arrays, I don't know if I'm on the right track here though. I found the code below reproduced on several sites.
I don't know how to organise my array and call it up though.
From this the row numbers with the top ten values should be the output, I can then try to work out how to filter.
But I don't want to re-arrange the data, just to filter the rows with the top ten values.
I was thinking of using a sort function for 2D arrays, I don't know if I'm on the right track here though. I found the code below reproduced on several sites.
I don't know how to organise my array and call it up though.
From this the row numbers with the top ten values should be the output, I can then try to work out how to filter.
VBA Code:
Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, _
Optional lngColumn As Long = 0)
On Error Resume Next
Dim I As Long
Dim J As Long
Dim varMid As Variant
Dim arrRowTemp As Variant
Dim lngColTemp As Long
If IsEmpty(SortArray) Then
Exit Sub
End If
If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name
Exit Sub
End If
If lngMin = -1 Then
lngMin = LBound(SortArray, 1)
End If
If lngMax = -1 Then
lngMax = UBound(SortArray, 1)
End If
If lngMin >= lngMax Then ' no sorting required
Exit Sub
End If
I = lngMin
J = lngMax
varMid = Empty
varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)
' We send 'Empty' and invalid data items to the end of the list:
If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
I = lngMax
J = lngMin
ElseIf IsEmpty(varMid) Then
I = lngMax
J = lngMin
ElseIf IsNull(varMid) Then
I = lngMax
J = lngMin
ElseIf varMid = "" Then
I = lngMax
J = lngMin
ElseIf VarType(varMid) = vbError Then
I = lngMax
J = lngMin
ElseIf VarType(varMid) > 17 Then
I = lngMax
J = lngMin
End If
While I <= J
While SortArray(I, lngColumn) < varMid And I < lngMax
I = I + 1
Wend
While varMid < SortArray(J, lngColumn) And J > lngMin
J = J - 1
Wend
If I <= J Then
' Swap the rows
ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
arrRowTemp(lngColTemp) = SortArray(I, lngColTemp)
SortArray(I, lngColTemp) = SortArray(J, lngColTemp)
SortArray(J, lngColTemp) = arrRowTemp(lngColTemp)
Next lngColTemp
Erase arrRowTemp
I = I + 1
J = J - 1
End If
Wend
If (lngMin < J) Then Call QuickSortArray(SortArray, lngMin, J, lngColumn)
If (I < lngMax) Then Call QuickSortArray(SortArray, I, lngMax, lngColumn)
End Sub