This method uses a parallel array that stores the id of the original array sorted correctly. to make the comparison does not go through the entire array,it is split into two to find your nearest location.

To test the sample to insert a ListBox, a CommandButton, a CheckBox, and Three OptionButton with index of 0 to 2

Code:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long


Private Type MyType
    Name As String
    Birthday As Date
    Age As Long
End Type

Dim m_OrderBy As Integer

Private MT() As MyType

Private Sub Command1_Click()
    Dim SortedArray() As Long
    Dim TempMT() As MyType
    Dim DescendingOrder As Boolean
    Dim LenMyArray As Long
    Dim i As Long

    Dim t As Long
    
    t = GetTickCount
    
    LenMyArray = UBound(MT)
        
    SortedArray = OrderedArray(LenMyArray)
        
        
    ReDim TempMT(UBound(MT))
    
    DescendingOrder = Check1.Value
    
    If DescendingOrder Then
        For i = 0 To LenMyArray
            TempMT(LenMyArray - i) = MT(SortedArray(i))
        Next
    Else
        For i = 0 To LenMyArray
            TempMT(i) = MT(SortedArray(i))
        Next
    End If
    
    MT = TempMT
    
    MsgBox "Time: " & GetTickCount - t
    
    List1.Clear
    

    For i = 0 To LenMyArray
        List1.AddItem MT(i).Name & Space(10) & MT(i).Birthday & Space(10) & MT(i).Age
    Next


End Sub

Private Function OrderedArray(ByVal UBoundArray As Long) As Long()
    Dim Index As Long, i As Long
    Dim Arr() As Long, LenArray As Long, TempArr() As Long
    Dim nInf As Long, nSup As Long, nMid As Long
    
    ReDim Arr(0)

    For Index = 1 To UBoundArray
        
        If GetVar(Arr(UBound(Arr))) <= GetVar(Index) Then
            ReDim Preserve Arr(UBound(Arr) + 1)
            Arr(UBound(Arr)) = Index
        Else
        
            nInf = 0
            nSup = UBound(Arr)
        
            Do
                nMid = (nSup - nInf) \ 2
            
                Do
                    If GetVar(Arr(nMid)) <= GetVar(Index) Then
                        nInf = nMid - 1
                        nMid = nMid + ((nSup - nInf) \ 2)
                    Else
                        nSup = nMid
                        Exit Do
                    End If
                Loop
                
                If nInf < 0 Then nInf = 0: Exit Do
                
                
                If nSup - nInf < 4 Then Exit Do
            Loop
                
        
            For i = nInf To nSup
                If GetVar(Arr(i)) >= GetVar(Index) Then
                
                    LenArray = UBound(Arr) + 1
                    
                    ReDim TempArr(LenArray)
                    If i > 0 Then CopyMemory TempArr(0), Arr(0), 4 * i
                    TempArr(i) = Index
                    CopyMemory TempArr(i + 1), Arr(i), 4 * (LenArray - i)
                    ReDim Arr(LenArray)
                    CopyMemory Arr(0), TempArr(0), 4 * (LenArray + 1)

                    Exit For
                End If
            Next
            
        End If
    Next
    
    OrderedArray = Arr
    
End Function


'Private Function GetVar(ByVal Index As Long) As Variant
'    Dim Value As String
    
'    Value = MT(Index).Caption

'    If IsNumeric(Value) Then
'        GetVar = Val(Value)
'    Else
'        If IsDate(Value) Then
'            GetVar = CDate(Value)
'        Else
'            GetVar = CStr(Value)
'        End If
'    End If
'End Function


'--------------------------------------
'Change this function for your use
'---------------------------------------
Private Function GetVar(ByVal Index As Long) As Variant
    Select Case m_OrderBy
        Case 0
            GetVar = MT(Index).Name
        Case 1
            GetVar = MT(Index).Birthday
        Case 2
            GetVar = MT(Index).Age
    End Select
End Function

Private Sub Option1_Click(Index As Integer)
    m_OrderBy = Index
End Sub


Private Sub Form_Load()
    Dim i As Long
    
    ReDim MT(10000)
    
    List1.FontName = "MS Mincho"
    
    Randomize

    For i = 0 To 10000
        MT(i).Name = GetRndName
        MT(i).Birthday = GetRandom(CDate("01/01/1930"), CDate("01/01/1995"))
        MT(i).Age = (Date - MT(i).Birthday) / 365
        List1.AddItem MT(i).Name & Space(10) & MT(i).Birthday & Space(10) & MT(i).Age
    Next
    
    Option1(0).Caption = "Name": Option1(0).Value = True
    Option1(1).Caption = "Birthday"
    Option1(2).Caption = "Age"
    Check1.Caption = "DescendingOrder"
    Command1.Caption = "Ordered"
End Sub

Private Function GetRndName() As String
    Dim i As Long
    For i = 1 To 6
        GetRndName = GetRndName & Chr(GetRandom(91, 64))
    Next
End Function

Private Function GetRandom(ByVal Lower As Variant, ByVal Upper As Variant) As Variant
    GetRandom = Int((Upper - Lower + 1) * Rnd() + Lower)
End Function
have to be modified to implement the function getVar this is what is responsible for obtaining the variable of our UDT or Array.

OrderedArray function is that returns the sorted array with the index and well within the event command1 can see how it is used.

I accept suggestions or criticism