Sort 2D array

[Formula11]

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.

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

 

[Fluff]

I don't want to re-arrange the data, just to filter the rows with the top ten values.

In that case why not just use the AutoFilter?

 

[Formula11]

OK thanks I'll look into this.

 

[Fluff]

Ok

 

[Formula11]

If this helps.
For example range "D2:D12", one array being the string length of each cell, another array being the row number ... and to sort by the first mentioned array.

Sub Test()
Debug.Print String(65535, vbCr)
    Dim ArrayLengthCell() As Variant, ArrayRowNumber() As Variant, ArrayBoth() As Variant
    Dim Cell As Range, RangeColumnD As Range
    Dim RowLast As Long
    Dim i As Long, j As Long
    
    RowLast = 12
    Set RangeColumnD = Range(Cells(2, 4), Cells(RowLast, 4))
    ReDim ArrayLengthCell(RowLast - 2): ReDim ArrayRowNumber(RowLast - 2): ReDim ArrayBoth(RowLast - 2, 1)
    'Array
    i = 0
    For Each Cell In RangeColumnD
        ArrayLengthCell(i) = Len(Cell.Value)
        ArrayRowNumber(i) = Cell.Row
        i = i + 1
    Next Cell
    
    For i = 0 To RowLast - 2
        ArrayBoth(i, 0) = ArrayLengthCell(i)
        For j = 1 To 1
            ArrayBoth(i, j) = ArrayRowNumber(i)
        Next
    Next
    'Sort in sequence
    Call QuickSortArray(ArrayBoth(), , , 0)
    'Test
    For i = 0 To RowLast - 1 - 1
        Debug.Print "i = " & i
        Debug.Print ArrayBoth(i, 0) & " Length of cell"
        Debug.Print ArrayBoth(i, 1) & " Row number"
        Debug.Print "-------"
    Next
End Sub

 

[Fluff]

If you are simply trying to filter the data by the length of the string in col D, there are two simple options
a) add a formula in a blank column =LEN(D2) fill down & then filter that col for top 10 items
b) put this formula in (for instance) H2 =LEN(D2)>=LARGE(LEN($D$2:$D$12),10) then use advanced filter with H1:H2 as the criteria range

 

[Formula11]

OK thanks, I'll bear that in mind.

 

[Fluff]

You're welcome