0

I have found the VBA code below after a Google search. It sorts an array alphabetically and is faster than Bubblesort. However I can't figure out how to modify the code to sort my single dimensional array, which is a file list, on the file extension? It's a mixture of Word files (.doc) and Excel files (.xlsx) in the array. I would like to sort the files so all the Word files are sorted before the Excel files. To clarify the array after the sort would be as per the following example...

    (filename.doc)
    (filename.doc)
    (filename.doc)
    (filename.doc)
    (filename.doc)
    (filename.xlsx)
    (filename.xlsx)
    (filename.xlsx)
    (filename.xlsx)

The code...

Sub Quicksort(vArray As Variant, arrLbound As Long, arrUbound As Long)
'Sorts a one-dimensional VBA array from smallest to largest
'using a very fast quicksort algorithm variant.
Dim pivotVal     As Variant
Dim vSwap        As Variant
Dim tmpLow       As Long
Dim tmpHi        As Long

tmpLow = arrLbound
tmpHi = arrUbound
pivotVal = vArray((arrLbound + arrUbound) \ 2)

While (tmpLow <= tmpHi)        'divide
    While (vArray(tmpLow) < pivotVal And tmpLow < arrUbound)
        tmpLow = tmpLow + 1
    Wend

    While (pivotVal < vArray(tmpHi) And tmpHi > arrLbound)
        tmpHi = tmpHi - 1
    Wend

    If (tmpLow <= tmpHi) Then
        vSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = vSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
    End If
Wend

If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi        'conquer
If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound        'conquer
End Sub

Any help would be greatly appreciated.

coombech
  • 5
  • 4
  • Find all places where `pivotVal` is used. In all these places, replace the *thing it is compared to* with `GetExtension(that thing it is compared to)`. Go back to the assignment of `pivotVal` itself and also replace it with `= GetExtension(what it was before)`. Then create a function called `GetExtension()` that accepts a string and returns the extension from that string, which can do by taking [this code](https://stackoverflow.com/a/5932955/11683) and replacing the `"\"` with a `"."`. – GSerg Apr 14 '20 at 09:02

1 Answers1

0

Thank you so much @GSerg, works perfectly! Would it be possible to take it one step further by also sorting on the folder names in the full path for each file? For example...

("C:\Path\FolderName1\filename.doc")
("C:\Path\FolderName1\filename.doc")
("C:\Path\FolderName1\filename.doc")
("C:\Path\FolderName2\filename.doc")
("C:\Path\FolderName3\filename.doc")
("C:\Path\FolderName4\filename.doc")
("C:\Path\FolderName4\filename.doc")
("C:\Path\FolderName4\filename.doc")
("C:\Path\FolderName1\filename.xlsx")
("C:\Path\FolderName1\filename.xlsx")
("C:\Path\FolderName1\filename.xlsx")
("C:\Path\FolderName2\filename.xlsx")
("C:\Path\FolderName3\filename.xlsx")
("C:\Path\FolderName4\filename.xlsx")
("C:\Path\FolderName4\filename.xlsx")
("C:\Path\FolderName4\filename.xlsx")

The foldernames in the example are numbered but the real data isn't. I would want them sorted alphabetically. At the moment when I run the quicksort sub, it sorts by file extension as I requested but the folders aren't sorted. Is this possible?

coombech
  • 5
  • 4
  • 2
    You'd better 1) post here your code solving your _original_ question. 2) then accept it in order to direct future readers 3) post the question here in a brand new question along with starting code – HTH Apr 14 '20 at 12:55
  • Yes, it would be. Undo the assignment of `pivotVal` with `GetExtension()` so that the original raw value is stored in there like before. Then find the comparisons involving `pivotVal` and `GetExtension(X)` and replace them with `compare(X, Y) < 0`, preserving the order of the arguments like in the original comparison, but removing the `GetExtension()`. Then create a function called `compare()` that accepts two strings, `X` and `Y`, and does this: `compare = StrComp(GetExtension(X), GetExtension(Y)) : If compare = 0 Then compare = StrComp(X, Y)`. – GSerg Apr 14 '20 at 20:33