Reorder 2D Array by time order

[djamieson18]

Hi All,

I have a 2D array where the first colum has a range of dates and the second colum has a range of numbers. I wish to reorder this array in time order. My attempts all seem to fail.

Does anyone know of a way of doing so?

Dim a As Date
Dim b As Date
Dim c As Date
Dim d As Date
a = "01/01/2012"
b = "31/01/2012"
c = "14/04/2012"
d = "31/03/2012"
Dim ArrayXY(3, 1)
ArrayXY(0, 0) = a
ArrayXY(1, 0) = b
ArrayXY(2, 0) = c
ArrayXY(3, 0) = d
ArrayXY(0, 1) = 5
ArrayXY(1, 1) = 6
ArrayXY(2, 1) = 8
ArrayXY(3, 1) = 7
 
        For i = First To Last - 1
            For j = i + 1 To Last
                If ArrayB(i, 1) > ArrayB(j, 1) Then
                    For k = FirstCol To LastCol
                        lTemp = ArrayB(j, k)
                        ArrayB(j, k) = ArrayB(i, k)
                        ArrayB(i, k) = lTemp
                    Next k
                End If
            strng = ""
            For z = LBound(ArrayB, 1) To UBound(ArrayB, 1)
                strng = strng & vbNewLine & ArrayB(z, 0)
            Next z
            MsgBox strng
            Next j
        Next i

Thanks

Dave

 

[MickG]

Perhaps !!

[COLOR="Navy"]Sub[/COLOR] MG14Apr38
[COLOR="Navy"]Dim[/COLOR] a [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] b [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] d [COLOR="Navy"]As[/COLOR] Date
a = "01/01/2012"
b = "31/01/2012"
c = "14/04/2012"
d = "31/03/2012"
[COLOR="Navy"]Dim[/COLOR] ArrayXY(1 To 4, 1 To 2)
[COLOR="Navy"]Dim[/COLOR] Temp1
[COLOR="Navy"]Dim[/COLOR] Temp2
[COLOR="Navy"]Dim[/COLOR] I [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] J [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
ArrayXY(1, 1) = a
ArrayXY(2, 1) = b
ArrayXY(3, 1) = c
ArrayXY(4, 1) = d
ArrayXY(1, 2) = 5
ArrayXY(2, 2) = 6
ArrayXY(3, 2) = 7
ArrayXY(4, 2) = 8
    [COLOR="Navy"]For[/COLOR] I = 1 To UBound(ArrayXY, 1)
        [COLOR="Navy"]For[/COLOR] J = I To UBound(ArrayXY, 1)
            [COLOR="Navy"]If[/COLOR] CDate(ArrayXY(J, 1)) < CDate(ArrayXY(I, 1)) [COLOR="Navy"]Then[/COLOR]
                Temp1 = ArrayXY(I, 1)
                Temp2 = ArrayXY(I, 2)
                  ArrayXY(I, 1) = ArrayXY(J, 1)
                    ArrayXY(I, 2) = ArrayXY(J, 2)
                        ArrayXY(J, 1) = Temp1
                        ArrayXY(J, 2) = Temp2
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] J
    [COLOR="Navy"]Next[/COLOR] I
      
       [COLOR="Navy"]For[/COLOR] n = 1 To UBound(ArrayXY)
          Txt = Txt & ArrayXY(n, 1) & " // " & ArrayXY(n, 2) & Chr(10)
       [COLOR="Navy"]Next[/COLOR] n
       
       MsgBox Txt
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mikerickson]

Using Excel's sort routine is faster than a bubble sort.

Dim ArrayXY as Variant
Dim blankCells As Range

' fill ArrayXY

With Sheet1.UsedRange
    Set blankCells = .Offset(0, .Columns.Count + 1)
End With
Set blankCells = blankCells.Resize(UBound(ArrayXY, 1), 2)

With blankCells
    .Value = ArrayXY
    .Sort key1:=.Cells(1, 1), Header:=xlNo
    ArrayXY = .Value
    .ClearContents
End With

 

[mikerickson]

If you have lots of data, one way that is quicker than Excel's cell sorting would be to combine two techniques, QuickSort and sorting an array of row indices.

Sorting on row indices requires that a working array of the row numbers of ArrayXY be created.
In the OP example that would be the array {1,2,3,4}
Then sort that array on the basis that rowN<rowM iff ArrayXY(N,1)<ArrayXY(M,1), giving the result {1,2,4,3}

Then use that sorted array of row numbers to create the result array.

The time saved by only swaping row numbers rather than swapping each column of ArrayXY every time a comparison is made is worth the effort.

Note that ArrayXY is a module wide variable in this formulation.

Dim ArrayXY As Variant

Sub test()
    Dim arrRowNumbers() As Long
    Dim SortedXY As Variant
    Dim i As Long
    
    ArrayXY = testData
    
    Rem create array of rownumbers
    ReDim arrRowNumbers(LBound(ArrayXY, 1) To UBound(ArrayXY, 1))
    For i = LBound(arrRowNumbers) To UBound(arrRowNumbers)
        arrRowNumbers(i) = i
    Next i
    
    Rem use quick sort to sort that array LT
    sortQuickly arrRowNumbers
    
    Rem read ArrayXY into SortedXY based on sorted array of row numbers
    ReDim SortedXY(LBound(ArrayXY, 1) To UBound(ArrayXY, 1), LBound(ArrayXY, 2) To UBound(ArrayXY, 2))
    For i = LBound(arrRowNumbers) To UBound(arrRowNumbers)
        SortedXY(i, 1) = ArrayXY(arrRowNumbers(i), 1)
        SortedXY(i, 2) = ArrayXY(arrRowNumbers(i), 2)
    Next i
    
    Range("g1:H25").Value = SortedXY
End Sub


Sub sortQuickly(ByRef inRRay As Variant, Optional ByVal descending As Boolean, Optional ByVal low As Long, Optional ByVal high As Long)
    Dim pivot As Variant
    Dim i As Long, pointer As Long
    If low = 0 Then low = LBound(inRRay)
    If high = 0 Then high = UBound(inRRay)
     
    pointer = low
     
    Call Swap(inRRay, (low + high) / 2, high)
    pivot = inRRay(high)
     
    For i = low To high - 1
        If LT(inRRay(i), pivot) Xor descending Then
            Call Swap(inRRay, i, pointer)
            pointer = pointer + 1
        End If
    Next i
    Call Swap(inRRay, pointer, high)
    If low < pointer - 1 Then
        Call sortQuickly(inRRay, descending, low, pointer - 1)
    End If
    If pointer + 1 <= high Then
        Call sortQuickly(inRRay, descending, pointer + 1, high)
    End If
End Sub

Function LT(aRow As Variant, bRow As Variant) As Boolean
    On Error Resume Next
    LT = (ArrayXY(aRow, 1) < ArrayXY(bRow, 1))
    On Error GoTo 0
End Function

 Sub Swap(ByRef inRRay, a As Long, b As Long)
    Dim temp As Variant
    temp = inRRay(a)
    inRRay(a) = inRRay(b)
    inRRay(b) = temp
End Sub