sort two dim array which is declared as one dim array and inserted values as array()

Question

I'm on dead end which I am no able to figure out even google up :(

Let's say I have this exemple (please do not comment that it might be better ways to create such an array, this is on purpose):

Dim someArray() As Variant: ReDim someArray(0 To 0)
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text1"), CLng(5), CDbl(100))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text2"), CLng(3), CDbl(101))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text4"), CLng(2), CDbl(102))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text3"), CLng(1), CDbl(100))

and what I need is to fugure out the function to sort by two columns in the someArray() from (1 to UBound(someArray)) based on two colums I pass as arguments:

• so eather first sort by second column (1) which is CStr, and if records are the same then sort by third column (2)
• or which two columns I will set as arguments in the function to sort out

Unfortunately I am very lost here... only option which is realy terrible is to insert data into new sheet, let worksheet function to sort it accordingly, and reinsert into array, which is something i definitely do not wish to do :(

thank you for ideas...

Answer 1

I took your question as a challenge and found a way to pseudo sort the jagged array in the way you need. I mean, it will rearrange the jagged array arrays according to their second element, or according to the third one, if the second ones are in good order:

Sub SortArraysInJaggedArray()
 Dim someArray() As Variant: ReDim someArray(0)
 someArray(0) = Array(6, CStr("text1"), CLng(5), CDbl(100)) 'to load the first array element. Otherwise, it would be empty
 ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text2"), CLng(3), CDbl(101))
 ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text4"), CLng(2), CDbl(102))
 ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text3"), CLng(1), CDbl(100))
 
 Dim arrS
 arrS = sortJaggArr(someArray, 1)
 
 'visually test the result:
 Debug.Print someArray(2)(1), arrS(2)(1): Stop
 Debug.Print someArray(3)(1), arrS(3)(1): Stop
End Sub

Function sortJaggArr(arrJ As Variant, sortCol As Long) As Variant
    Dim i As Long, j As Long, arrInit, arrSort, arrComp, arrMtch
    
ReCheck:
 ReDim arrInit(UBound(arrJ))
 For i = 0 To UBound(arrJ)
    arrInit(i) = arrJ(i)(sortCol)
 Next
 arrSort = arrInit: BubbleSort arrSort
 'Debug.Print Join(arrInit, "|"): Debug.Print Join(arrSort, "|")
 'build a comparison array a continuous range of numbers:
 arrComp = Evaluate("TRANSPOSE(ROW(1:" & UBound(arrInit) + 1 & "))")
 'obtain an array of each element matching:
 arrMtch = Application.match(arrInit, arrSort, 0) 'returns an array of matches
  'Debug.Print Join(arrMtch, "|"): Stop
 'check if arrSort is different than arrInit:
 If Join(arrComp, "") = Join(arrMtch, "") Then 'if they match, try the next column
    sortCol = sortCol + 1
    If sortCol <= 2 Then GoTo ReCheck
 End If
 If sortCol = UBound(arrJ) Then
    MsgBox "The array is already sorted..."
    sortJaggArr = arrJ: Exit Function
 End If
 'Debug.Print Join(arrComp, "|"): Debug.Print Join(arrMtch, "|"): Stop
 'make the sorting of arrays
 Dim newArr: ReDim newArr(UBound(arrJ))
 For i = 0 To UBound(arrJ)
    If arrComp(i + 1) = arrMtch(i + 1) Then
        newArr(i) = arrJ(i)
    Else
        newArr(i) = arrJ(arrMtch(i + 1) - 1)
    End If
 Next i
 sortJaggArr = newArr
End Function

Private Sub BubbleSort(arr)
    Dim i As Long, j As Long, temp
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i): arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

I let in the function (for instructional purpose) some commented lines, to offer the possibility to see what is the return of specific (joined) arrays...

Please, send some feedback after testing it.

If something not clear enough, please do not hesitate to ask for clarifications...