excel - VBA sorting 2 dimensional array (text values in alphabetical order) - optimization

Question

To receive an array with data sorted alphabetically in Excel, I always use something like this:

With ThisWorkbook.Worksheets("data")
    LastRow = .Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    .Range("a2:b" & LastRow).Sort key1:=.Range("a1"), order1:=xlAscending
    vData = .Range("a2:b" & LastRow)
End With

I can have up to 3 sorting criteria, an infinite number if I run sort multiple times with different sort parameters.

The problem is that it takes time. The worst is when I receive an array as a result of operations within the code and I must first paste the array into worksheet, then sort. With a few hundred thousands of rows, it will take a few seconds.

I used my modifications of QuickSort algorithms to sort numbers, but I imagine that sorting text alphabetically would require 'StrComp', which from my experience is relatively time consuming.

Have you seen or do you think it possible to create a VBA 2 dimensional array alphabetical sorting algorithm (can even be 1 criteria column), which will perform faster than Range.Sort (or pasting huge array + sort)? If yes, how would the strings be compared?

Answer 1

You can try using methods from the ADODB library and simply do a SELECT query on your data where you ORDER BY the text columns in the data which negates the need to write a custom sorting function.

Using this approach will allow you to scale to any number of text columns without worrying how the custom function will deal with multiple columns of text data.

Sample data and output:

Sample code for above - please follow the comments.

Option Explicit

Sub SortDataBy2TextColumnsWithADO()

    Dim rngInput As Range
    Dim rngOutput As Range
    Dim strWbName As String
    Dim strConnection As String
    Dim objConnection As ADODB.Connection
    Dim strRangeReference As String
    Dim strSql As String
    Dim objRecordSet As ADODB.Recordset
    Dim varSortedData As Variant
    Dim wsf As WorksheetFunction

    ' set input range - includes header
    Set rngInput = ThisWorkbook.Worksheets("Sheet1").Range("A1:C19")

    ' set output range - just the first cell
    Set rngOutput = ThisWorkbook.Worksheets("Sheet1").Range("E1")

    ' copy the headers over
    rngOutput.Resize(1, 3).Value = rngInput.Rows(1).Value

    ' connection string for ACE OLEDB provider
    strWbName = ThisWorkbook.FullName
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & strWbName & ";" & _
        "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    ' make the connection to current workbook (better saved the workbook first)
    Set objConnection = New ADODB.Connection
    objConnection.Open strConnection

    ' get range reference as a string suitable for sql query
    strRangeReference = "[" & rngInput.Parent.Name & "$" & rngInput.Address(False, False) & "]"
    ' get the data ordered by text columns (1 and 2) and values (3)
    strSql = "select * from " & strRangeReference & " order by 1, 2, 3"

    ' populate the recordset
    Set objRecordSet = New ADODB.Recordset
    objRecordSet.Open strSql, objConnection

    ' get the sorted data to the variant
    varSortedData = objRecordSet.GetRows

    ' need to transpose the sorted data
    varSortedData = WorksheetFunction.Transpose(varSortedData)

    ' output the transposed sorted data to target range
    rngOutput.Offset(1, 0).Resize(UBound(varSortedData, 1), UBound(varSortedData, 2)).Value = varSortedData

    ' clean up
    objRecordSet.Close
    Set objRecordSet = Nothing
    objConnection.Close
    Set objConnection = Nothing

End Sub

Note the following:

• I got errors on an unsaved workbook - so probably better than you have saved the workbook at least once
• The sorted data needs to be transposed for the output range - see here and here