arraysvbasortingmultidimensional-arrayvba6

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


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:

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...


Solution

  • 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...