Sorting rows of string data in vba

Question

I'd like to sort delimited data rows on the fly using VBA. Here is the data that I have:

PM-10663 ::: AK:::1:::Jupiter_PI6-1:::Relinquishment request cancled time out 
PM-10721 ::: AK:::3:::Jupiter_PI6-2:::Automate SAS Simulator configuration - Prepare Dummy test files
PM-76960 ::: EA:::3:::Jupiter_PI6-1:::Handle Heartbeat Expire timer (interval) Received in Grant/Heartbeat Response
PM-99200 ::: EA:::3:::Jupiter_PI6-1:::Scheduled Job Support First HeartBeat - Transmit Expiry
PM-10684 ::: EA:::1:::Jupiter_PI6-2:::Update Swagger for Rest API to FE
PM-10822 ::: EA:::1:::Jupiter_PI6-2:::Add Code Owners
PM-10807 ::: EA:::2:::Jupiter_PI6-2:::Enabling SAS Cleaning Data 
PM-10327 ::: EA:::1:::Jupiter_PI6-2:::Add Coverage.out file to Domain-proxy repo to access to jenkins workspace
PM-73860 ::: KO:::3:::Jupiter_PI6-1:::Algorithm to obtain grant requests for RUs within same bandwidth - Part 2
PM-10472 ::: KO:::2:::Jupiter_PI6-1:::updating the api-spec go version
PM-99370 ::: KO:::3:::Jupiter_PI6-1:::Build Swagger for Rest API to FE
PM-10132 ::: KO:::5:::Jupiter_PI6-1:::Configure the SAS Simulator to test SAS errors
PM-10029 ::: KO:::2:::Jupiter_PI6-2:::Consider moving to Orchestration NATS bus to facilitate the Authentication and Authorization
PM-97240 ::: OM:::1:::Jupiter_PI6-1:::Define nats subject/schema definition for publish/subscribing CBSD_info_update message
PM-98250 ::: OM:::1:::Jupiter_PI6-1:::Procure the NB swagger/gRPC specification of retrieving CBSD_info_update from CBRS
PM-99420 ::: OM:::1:::Jupiter_PI6-1:::Configure the structure API client for DP
PM-10661 ::: OM:::3:::Jupiter_PI6-2:::Relinquishment failed.
PM-10662 ::: OM:::1:::Jupiter_PI6-2:::Relinquishment request canceled time out 
PM-77000 ::: OM:::3:::Jupiter_PI6-2:::Create Transmit Expiry Timer in Heartbeat Response
PM-93300 ::: OM:::3:::Jupiter_PI6-2:::Handle Grant Expire Timer Received in Grant Response - Part 2 
PM-98440 ::: OM:::3:::Jupiter_PI6-2:::Expose a Rest API to FE to provide SAS Default URL
PM-10217 ::: OM:::3:::Jupiter_PI6-1:::Hardcode the flow of DP - SAS communication

I want to first group by the second element (e.g., AK, EA, KO etc.,) and then group by the fourth element (e.g., Jupiter_PI6-x) and finally sort the data by the first element (PM-xxxxx).

This is how the data looks like right now:

And this is how I want the outcome to be:

I cannot use Excel sort because it means that I need to save, read, and write the data in a separate worksheet using sorting algorithms. I am getting this data via an API call into a VBA dictionary object. So, I need to use arrays or something to separate out the data. I have very limited knowledge about data arrays, let alone multiple arrays. I'd be very thankful if someone could help me with this.

So are we to assume that each Value in the Dictionary is one of the lines, above, and each line is a String (with the individual elements always delimited by the 3 colons)? The first delimiter is surrounded by space characters ... are these to be ignored/removed (before the sort)? What is in the Keys in the Dictionary? — JohnM, Jul 07 '23 at 14:14
"I need to save, read, and write the data in a separate worksheet using sorting algorithms" - no you don't. You can use a temporary worksheet to split the data out, re-order it and concatenate it back together again. Then just throw that worksheet away. — CHill60, Jul 07 '23 at 15:01

FunThomas · Answer 1 · 2023-07-07T15:39:29.377

There is no build-in sort to a Dictionary. Easiest way is to use an AdoDB.RecordSet for that.

Basically, create a Recordset with 5 fields, the first for the key of the dictionary, the other 4 fields contains pieces of your long string. Loop over your dictionary and add 1 records per entry. You can easily split this long string into pieces (I call them "tokens") with the Split function.

Now all you have to do is to issue the Sort-command and loop over the Recordset. Use the key-field to access the original entry of the Dict:

Sub SortMyDict(d as Dictionary)
    ' Create a Recordset with 5 string fields
    Dim rs As New ADODB.Recordset
    rs.Fields.Append "key", adChar, 100
    rs.Fields.Append "f1", adChar, 100
    rs.Fields.Append "f2", adChar, 100
    rs.Fields.Append "f3", adChar, 100
    rs.Fields.Append "f4", adChar, 100
    rs.Open
    
    ' Loop over the dictionary to fill Recordset
    Dim key
    For Each key In d
        Dim tokens() As String
        tokens = Split(d(key), ":::")
        
        rs.AddNew Array("key", "f1", "f2", "f3", "f4"), Array(CStr(key), tokens(0), tokens(1), tokens(2), tokens(3))
    Next
    ' Sort
    rs.Sort = "f2, f4, f1"
    ' Loop over sorted recordset.
    rs.MoveFirst
    Do While Not rs.EOF
        key = Trim(rs("key"))
        Debug.Print d(key)   ' Make up your mind what you want to do here.
        rs.MoveNext
    Loop

End Sub

Note that I always advocate for early binding, so you need to add references to the Scripting.Runtime and Microsoft ActiveX Data Objects.

Nice. I had forgotten about `rs.Sort`. – Brian M Stafford Jul 07 '23 at 16:17 — Brian M Stafford, Jul 07 '23 at 16:17

score 0 · Answer 2 · answered Jul 07 '23 at 15:24

This works but may need tweaking to fit your data

Sub SplitAndSort()

    Dim arr1 As Variant
    arr1 = ThisWorkbook.Sheets("Sheet1").UsedRange.Value
    
    Dim lvar As Long, v As Variant
    For lvar = LBound(arr1) To UBound(arr1)
        v = Split(arr1(lvar, 1), ":::")
        'Add the sort criteria to the start of the string. Separate with !!!
        arr1(lvar, 1) = v(1) & v(3) & "!!!" & arr1(lvar, 1)
    Next
    
    'See https://stackoverflow.com/questions/152319/vba-array-sort-function
    QuickSort arr1, LBound(arr1), UBound(arr1)

    'Remove the stuff we added
    For lvar = LBound(arr1) To UBound(arr1)
        v = Split(arr1(lvar, 1), "!!!")
        arr1(lvar, 1) = v(1)
        Debug.Print v(1)
    Next

End Sub

I adapted the QuickSort at VBA array sort function? - my variant array ends up with an extra dimension so I just added ,1 everywhere it referred to vArray

Sorting rows of string data in vba

2 Answers2