18 thoughts on “Sorting Arrays of User Defined Types”

1. Dick,

   If you just want to sort a type on max. 3 fields you could copy your array values to a (new) worksheet, one value per cell, and use the build in sort function of Excel. After sorting copy the values in the (sorted) worksheet back to the array.
   It’s limited to max 3 fields and 65536 values per field. I’m not sure which method is faster, I’d have to test. On the bright side; you’re getting the MatchCase argument for free with this method ;-)

   Rembo

   —
   Sub SortInfo(aInfo() As MyInfo)

   Dim i As Long, j As Long

   ‘Copy aInfo to 3rd worksheet
   For i = 0 To UBound(aInfo())
   With Worksheets(3)
   .Range(“A” & i + 1).Value = aInfo(i).lType
   .Range(“B” & i + 1).Value = aInfo(i).sName
   .Range(“C” & i + 1).Value = aInfo(i).dStart
   End With
   Next i

   ‘Sort the data
   Worksheets(3).Range(“A1?).Sort Key1:=Range(“A1?), Order1:=xlAscending, _
   Key2:=Range(“B1?), Order2:=xlAscending, Key3:=Range(“C1?), Order3:=xlAscending, _
   Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

   ‘Copy sorted data back to aInfo
   For i = 0 To UBound(aInfo())
   With Worksheets(3)
   aInfo(i).lType = .Range(“A” & i + 1).Value
   aInfo(i).sName = .Range(“B” & i + 1).Value
   aInfo(i).dStart = .Range(“C” & i + 1).Value
   End With
   Next i
   End Sub

2. Dick,
   An ‘easier’ way to populate the array:

   ‘fill the array with some unsorted data
   For i = 0 To 4
   aInfo(i).lType = Array(2, 1, 1, 2, 1)(i)
   aInfo(i).sName = Array(“Joe”, “Bob”, “Bob”, “Joe”, “Joe”)(i)
   aInfo(i).dStart = Array(#1/1/2006#, #2/1/2006#, #1/15/2006#, #6/30/2005#, #1/8/2006#)(i)
   Next i

   Sorting is a lifestyle choose, so of course I choose ADO:

   Sub SortInfo(ByRef aInfo() As MyInfo)

   ‘ Create disconnected recordset
   Dim rs As Object
   Set rs = CreateObject(“ADOR.Recordset”)
   With rs
   .fields.append “Type”, 3 ‘ INTEGER
   .fields.append “Name”, 202, 35 ‘ NVARCHAR(35)
   .fields.append “Start”, 7 ‘ DATETIME
   .Open

   ‘ Populate
   Dim rows As Long
   rows = UBound(aInfo, 1) – LBound(aInfo, 1) + 1

   Dim row As Long
   For row = 0 To rows – 1
   .AddNew
   .fields(“Type”).Value = aInfo(row).lType
   .fields(“Name”).Value = aInfo(row).sName
   .fields(“Start”).Value = aInfo(row).dStart
   Next

   ‘ Sort all cols ascending
   .Sort = “Type ASC, Name ASC, Start ASC”

   .MoveFirst
   For row = 0 To rows – 1
   aInfo(row).lType = .fields(“Type”).Value
   aInfo(row).sName = .fields(“Name”).Value
   aInfo(row).dStart = .fields(“Start”).Value
   .MoveNext
   Next

   End With

   End Sub

   Jamie.

   –

3. Rembo –

   You should put your values into a 3xN array before dumping them into the worksheet in one step, and read the sorted values back into VBA in one step. Going cell-by-cell is will be slo-o-o-o-ow.

   – Jon

4. Very cool stuff! Now I know how to use Type statements! Thanks for the post!

5. I wrote a sort add-in for excel, (it can be found here: http://www.donationcoder.com/Forums/bb/index.php?topic=2413.0) that performs a natural quicksort and can sort by color. I dont quite understand what a User Defined Type is… my add-in works on ranges. What’s the difference?

   Kevin

6. Did this in VB6 but it should work in VBA too.

   Private Sub SortInfo(ByRef aInfo() As MyInfo)

   Dim i As Long, j As Long
   Dim temp As String * 10
   Dim a As String, b As String

   ‘standard bubble sort loops
   For i = LBound(aInfo) To UBound(aInfo) – 1
   For j = i To UBound(aInfo)

   LSet temp = aInfo(i).sName
   a$ = Format$(aInfo(i).lType, “0000000000?) & temp & Format$(CDbl(aInfo(i).dStart), “000000.000000?)
   LSet temp = aInfo(j).sName
   b$ = Format$(aInfo(j).lType, “0000000000?) & temp & Format$(CDbl(aInfo(j).dStart), “000000.000000?)

   ‘Debug.Print a$, b$

   If a$ > b$ Then
   SwapInfo aInfo, i, j
   End If
   Next j
   Next i

   End Sub

   Hugh,

7. Dick,

   Here’s a slight alteration on your sort routine that maybe more visually pleasing:

   Sub SortInfoNew(ByRef bInfo() As MyInfo)

   Dim i As Long, j As Long
   Dim tTemp As MyInfo

   ‘standard bubble sort loops
   For i = LBound(bInfo) To UBound(bInfo) – 1
   For j = i To UBound(bInfo)
   ‘sort on the first element
   If SwapInfoNew(bInfo, bInfo(i).lType, bInfo(j).lType, i, j) = False Then
   ‘if the first element is the same, sort on the second
   If SwapInfoNew(bInfo, bInfo(i).sName, bInfo(j).sName, i, j) = False Then
   ‘if the first two elements are the same, sort on the third
   SwapInfoNew bInfo, bInfo(i).dStart, bInfo(j).dStart, i, j
   End If
   End If
   Next j
   Next i
   End Sub
   ‘
   Function SwapInfoNew(ByRef bInfo() As MyInfo, ByVal Info1 As Variant, ByVal Info2 As Variant, ByVal lOne As Long, ByVal lTwo As Long) As Boolean
   Dim tTemp As MyInfo
   SwapInfoNew = True ‘ For Info’s not equal
   If Info1 > Info2 Then ‘ Swap data only on greater than
   tTemp = bInfo(lOne)
   bInfo(lOne) = bInfo(lTwo)
   bInfo(lTwo) = tTemp
   ElseIf Info1 = Info2 Then
   SwapInfoNew = False
   End If
   End Function

8. Hi:

   This post does two things.

   First, it shares a generic sort routine that works with any object.

   Second, as I had mentioned in some earlier post I wanted to come up with a way of posting comments that were threaded and retained leading spaces in code.

   The solution to both may — and I emphasize may — be this software from http://www.mutantpenguin.co.uk that supports web access, newsreader access, and atom and rss feeds. This is an experiment and may not be supported on a permanent basis. But, if it works, great.

   http://tmc.newsgrouphosting.com/readmessage?id=%3C4b2ec46d$1930c83b$2661@mps%3E&group=tmc.blogposts

   You are invited to explore the interface — some of my fellow Microsoft MVPs are already familiar with it — and comment on it.

9. Tushar Mehta: “One can leverage that additional capability to write a generic sort routine that
   works with *any* kind of object.”

   JamieC: Your code requires those objects have properties named DataType, UserName and StartDate. For me, that does not equate to any kind of object; in fact, not one of my classes would be able to use your ‘generic’ routine.

   Rather than late binding using Variant variables, one could do it ‘correctly’ and leverage the advantages of early binding (IntelliSense, syntax checking, improved runtime performance, etc) by creating an interface class, say IMehtaData (sorry, couldn’t resist :)), which classes needing to use the SortInfo method can Implement. This way the arguments to SortInfo can be typed as IMehtaData and you could legitimately say that your method were “a generic sort routine that
   works with *any* object of a class that Implements my IMehtaData interface.”

   Jamie.

   –

10. Jamie,

    Where in the sort routine does the code require any specific class property? It only needs a class that implements the sortClassItems method. I’ve duplicated the SortInfo routine below though I imagine it will be posted w/o any indentation.

    Sub SortInfo(ByRef aInfo As Variant)
    ‘Basic bubble sort

    Dim i As Long, j As Long

    For i = LBound(aInfo) To UBound(aInfo) – 1
    For j = i + 1 To UBound(aInfo)
    aInfo(i).sortClassItems aInfo(i), aInfo(j)
    Next j
    Next i

    End Sub

11. Tushar,
    Let me try from a different angle. Do you agree that having weakly-typed arguments to your procedures is less than ideal? You’ve used the key word ‘implements’ in your reply but not in your code ;).

    Because your SortInfo routine has a Variant parameter it will compile and even run for any class but it’s kind of relying on coincidence to work i.e. late binding will ‘discover’ a SortInfo method at run-time.

    What I’m saying is, if one’s aim is to do things ‘correctly’ then it would be better to use early binding. In other words, you have stated in your description that the implementation class must have a SortInfo method but you haven’t imposed that requirement in your code.

    You could define an interface class with a SortInfo method which your ‘sortable’ classes can implement. Trouble is, this SortInfo would itself need weakly typed parameters.

    I was thinking one step ahead, more along these lines:

    ‘ Class module: IMehtaData
    Option Explicit

    Property Get DataType() As Long: End Property
    Property Let DataType(ByRef RHS As Long): End Property

    Property Get UserName() As String: End Property
    Property Let UserName(ByRef RHS As String): End Property

    Property Get StartDate() As Date: End Property
    Property Let StartDate(ByRef RHS As Date): End Property
    ‘ Class module: IMehtaData

    ‘ Class module: MyInfo
    Option Explicit

    Implements IMehtaData

    Dim lType As Long, sName As String, dStart As Date

    Private Property Get IMehtaData_DataType() As Long: IMehtaData_DataType = lType: End Property
    Private Property Let IMehtaData_DataType(uType As Long): lType = uType: End Property

    Private Property Get IMehtaData_UserName() As String: IMehtaData_UserName = sName: End Property
    Private Property Let IMehtaData_UserName(uName As String): sName = uName: End Property

    Private Property Get IMehtaData_StartDate() As Date: IMehtaData_StartDate = dStart: End Property
    Private Property Let IMehtaData_StartDate(uStart As Date): dStart = uStart: End Property
    ‘ Class module: MyInfo (end)

    ‘ In an implementation class
    Public Sub sortClassItems( _
    ByRef Obj1 As IMehtaData, _
    ByRef Obj2 As IMehtaData)
    If Obj1.DataType > Obj2.DataType Then
    swapItems Obj1, Obj2
    ElseIf Obj1.DataType Obj2.UserName Then
    swapItems Obj1, Obj2
    ElseIf Obj1.UserName Obj2.StartDate Then
    swapItems Obj1, Obj2
    End If
    End Sub

    Sub swapItems( _
    ByRef Obj1 As IMehtaData, _
    ByRef Obj2 As IMehtaData)
    Dim Temp As IMehtaData
    Set Temp = Obj1
    Set Obj1 = Obj2
    Set Obj2 = Temp
    End Sub
    ‘ In an implementation class (any)

    Jamie.

    –

12. Speaking of doing things ‘correctly’, like Tushar I too had the idea of making the UDF a class but then to have a collection class to organize the instances and a parent class which could sort its children, a bit like this:

    ‘ Class module: CParent
    Option Explicit

    Public Enum InfoTypeEnum
    InfoTypeGood
    InfoTypeBad
    InfoTypeUgly
    End Enum

    Private m_MyInfos As CMyInfos

    Private Sub Class_Initialize()
    Set m_MyInfos = New CMyInfos
    m_MyInfos.SetParent ObjPtr(Me)
    End Sub

    Public Function EnumerateInfoType(ByVal infoType As InfoTypeEnum)
    Select Case infoType
    Case InfoTypeGood
    EnumerateInfoType = “Good”
    Case InfoTypeBad
    EnumerateInfoType = “Bad”
    Case InfoTypeUgly
    EnumerateInfoType = “Ugly”
    End Select
    End Function

    Public Property Get MyInfos() As CMyInfos
    Set MyInfos = m_MyInfos
    End Property

    Public Property Get Output() As String
    Dim sReturn As String
    Dim myInfo As CMyInfo
    For Each myInfo In m_MyInfos
    sReturn = sReturn & myInfo.Output & vbCrLf
    Next
    sReturn = Left$(sReturn, Len(sReturn) – Len(vbCrLf))
    Output = sReturn
    End Property
    ‘ Class module: CParent (end)

    ‘ Class module: CMyInfos
    Option Explicit

    Private m_rsMyInfos As ADODB.Recordset
    Private m_colMyInfos As Collection
    Private m_pParent As Long

    Public Property Get Item(ByVal Index As Variant) As CMyInfo
    ‘ Attribute Item.VB_UserMemId = 0 ‘ uncomment in text editor
    Set Item = m_colMyInfos.Item(Index)
    End Property

    Public Property Get NewEnum() As IUnknown
    ‘ Attribute NewEnum.VB_UserMemId = -4 ‘ uncomment in text editor
    ‘ Attribute NewEnum.VB_MemberFlags = “40? ‘ uncomment in text editor
    Set NewEnum = m_colMyInfos.[_NewEnum]
    End Property

    Friend Sub SetParent(ByVal Ptr As Long)
    m_pParent = Ptr
    End Sub

    Public Function Add( _
    ByVal Name As String, _
    ByVal StartDate As Date, _
    ByVal infoType As InfoTypeEnum _
    ) As CMyInfo

    Dim myInfo As CMyInfo

    Set myInfo = New CMyInfo
    m_colMyInfos.Add myInfo, CStr(ObjPtr(myInfo))

    With myInfo
    .Init Name, StartDate, infoType
    .SetParent m_pParent
    End With

    Set Add = myInfo
    End Function

    Public Property Get Count() As Long
    Count = m_colMyInfos.Count
    End Property

    Friend Function Remove(ByVal Index As Variant) As Boolean
    On Error Resume Next
    m_colMyInfos.Remove Index
    Remove = (Err.Number = 0)
    On Error GoTo 0
    End Function

    Private Sub Class_Initialize()
    Set m_colMyInfos = New Collection
    End Sub

    Friend Function Init( _
    ByVal Ptr As Long _
    ) As Boolean
    m_pParent = Ptr
    Init = True
    End Function

    Private Sub Class_Terminate()
    Dim myInfo As CMyInfo
    For Each myInfo In m_colMyInfos
    myInfo.SetParent 0
    Next
    End Sub

    Public Sub Sort()

    Dim memberCount As Long
    memberCount = m_colMyInfos.Count
    If memberCount < 2 Then ‘ less than two
    Exit Sub
    End If

    Set m_rsMyInfos = New ADODB.Recordset
    With m_rsMyInfos
    .Fields.Append “Name”, adVarChar, 35
    .Fields.Append “StartDate”, adDate
    .Fields.Append “InfoType”, adInteger
    .Fields.Append “CInfo”, adIUnknown
    .Open

    Dim myInfo As CMyInfo
    Dim row As Long

    For row = 1 To memberCount
    Set myInfo = m_colMyInfos(row)
    .AddNew
    .Fields(“Name”).Value = myInfo.Name
    .Fields(“StartDate”).Value = myInfo.StartDate
    .Fields(“InfoType”).Value = myInfo.infoType
    .Fields(“CInfo”).Value = myInfo
    Next

    .Sort = “Name, StartDate, InfoType”

    Dim colMyInfos As Collection
    Set colMyInfos = New Collection

    .MoveFirst
    For row = 1 To memberCount
    Set myInfo = .Fields(“CInfo”).Value
    colMyInfos.Add myInfo, CStr(ObjPtr(myInfo))
    .MoveNext
    Next

    Set m_colMyInfos = colMyInfos

    End With

    End Sub
    ‘ Class module: CMyInfos (end)

    ‘ Class module: CMyInfo
    Option Explicit

    Private m_Name As String
    Private m_StartDate As Date
    Private m_InfoType As InfoTypeEnum

    Private m_pParent As Long
    Private Declare Sub CopyMemory Lib “kernel32? Alias “RtlMoveMemory” _
    (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

    Friend Sub SetParent(ByVal Ptr As Long)
    m_pParent = Ptr
    End Sub

    Private Function CParentFromPtr(ByVal Ptr As Long) As CParent
    Dim tmp As CParent
    CopyMemory tmp, Ptr, 4
    Set CParentFromPtr = tmp
    CopyMemory tmp, 0&, 4
    End Function

    Public Property Get Parent() As CParent
    If m_pParent = 0 Then
    Exit Property
    End If
    Set Parent = CParentFromPtr(m_pParent)
    End Property

    Friend Sub Init( _
    ByVal Name As String, _
    ByVal StartDate As Date, _
    ByVal infoType As InfoTypeEnum _
    )
    m_Name = Name
    m_StartDate = StartDate
    m_InfoType = infoType
    End Sub

    Public Property Get Name() As String
    Name = m_Name
    End Property

    Public Property Get StartDate() As Date
    StartDate = m_StartDate
    End Property

    Public Property Get infoType() As InfoTypeEnum
    infoType = m_InfoType
    End Property

    Public Property Get Output() As String
    Output = _
    m_Name & vbTab & _
    Format$(m_StartDate, “yyyy-mm-dd”) & vbTab & _
    Parent.EnumerateInfoType(m_InfoType)
    End Property
    ‘ Class module: CMyInfos (end)

    ‘ Example usage
    Sub UseClasses()

    Dim Parent As CParent
    Set Parent = New CParent
    With Parent

    Dim i As Long
    For i = 0 To 4
    .MyInfos.Add _
    Array(“Joe”, “Bob”, “Bob”, “Joe”, “Joe”)(i), _
    Array(#1/1/2006#, #2/1/2006#, #1/15/2006#, #6/30/2005#, #1/8/2006#)(i), _
    Array(2, 1, 1, 2, 1)(i)
    Next i
    Debug.Print .Output
    Debug.Print
    .MyInfos.Sort
    Debug.Print .Output
    End With

    End Sub
    ‘ Example usage (end)

    But then I thought, maybe that’s too much for a blog.

    Jamie.

    –

13. Jamie, When writing about an ISortableObject interface in Chapter 11 of Professional Excel Development, I decided to just use a Variant SortKey and assume the reader would only use it to sort objects that had sort keys of similar data types.

14. Stephen,
    Erm, I don’t have your book to hand :) Remind me: what criteria did you apply in deciding not to go the interface route? We don’t want to encourge the ‘Stephen Bullen does it so it must be OK’ attitude, do we ;)?

    I suspect it came down to the fact that the interface would be very limited; it would not include any code to implement the sort, of course.

    I still think it is worth using an interface class rather than assuming a coder will use the class/implementation correctly. I prefer the type library to indicate usage rather than the written documentation. And I think avoiding late binding is a worthy goal.

    Just this week I defined this ‘zero code’ interface class:

    ‘ Class module: IColumnParent
    Option Explicit
    ‘ Class module: IColumnParent (end)

    ‘ Included in class module: CColumn
    Friend Sub SetParent(ByVal Ptr As Long)
    m_pParent = Ptr
    End Sub

    Private Property Get Parent() As IColumnParent
    If m_pParent = 0 Then
    Exit Property
    End If
    Dim tmp As IColumnParent
    CopyMemory tmp, Ptr, 4
    Set Parent = tmp
    CopyMemory tmp, 0&, 4
    End Property
    ‘ Included in class module: CColumn (end)

    ‘ Included in implementation class e.g. CTable
    Implements IColumnParent
    Private m_Columns As CColumns

    Private Sub Class_Initialize()
    Set m_Columns = New CColumns
    m_Columns.Init ObjPtr(Me)
    ‘ Included in implementation class e.g. CTable (end)

    ‘ Included in implementation class’s collection class e.g. CTables
    Friend Sub Init(ByVal Ptr As Long)
    m_pParent = Ptr
    End Sub

    Public Function Add(ByVal TableName As String) As CTable
    Dim oTable As CTable
    Set oTable = New CTable
    oTable.SetParentSchema m_pParentSchema
    …
    End Function
    ‘ Included in implementation class’s collection class e.g. CTables (end)

    The idea is that only certain classes will be the parent of a Column, say a Table, a View or a Procedure; to do so those classes must implement the ‘zero code’ IColumnParent class. The alternative to this was for CColumn to have three properties: ParentTable, ParentView, and ParentProcedure, only one of which could be non-null, then the associated maintenance e.g. what if a later class could also be the parent?

    Although the zero code interface seems strange it’s my current preferred solution. My next step is to examine the parents of CColumn for common functionality which should perhaps be defined in IColumnParent.

    Jamie.

    –

15. Jamie,

    If you think one late bound reference to one method that is anyway enforced by the system at run time is enough justification to use recordsets, collections, and APIs to move memory around, fine.

    Too many have a knee-jerk reaction to things like variants and late binding. They miss out on not only the elegant simplicity but *also* the raw power embedded in those capabilities.

    And, BTW, dimensioning variables as integers, reals, or strings is only a miniscule step better than declaring them as variants. Those constructs, more in tune with the demands of the programming environments from the late ’60s to mid ’80s, are woefully inadequate for modern computing requirements.

16. Jamie,

    In PED, I did indeed use an Interface class, called ISortableObject, which contained a single property called SortKey, which was typed as a Variant. So I got the compile-time knowledge that my classes could be sorted by a generic routine, but I didn’t dirty the interface and sort routine by having different data types to sort on.

    Like most things in Excel (and something we tried to emphasis in PED), there is no “One True Way” of doing anything. Every method will be better or worse depending on the criteria used to evaluate it, and that criteria is most often defined by the problem space, not the developer.

17. Tushar,
    I need no good excuse to use recordsets, collections, and APIs :) BTW the RtlMoveMemory is for my current (ultimate?) approach to the classic COM circular reference problem i.e. parent holds a reference to the child and child needs to hold a reference to the parent (how do you do it? I find this an excellent interview question).

    I think your latter comments are a miniscule amount disingenuous (or tongue in cheek), otherwise you would use a Variant for every variable in your code, wouldn’t you?

    In my line of business I have encountered few situations where a ‘real’ data type is required, yet I often see Single and Double used rather than the more appropriate Decimal, which was implemented in VBA as a Variant. I’d use fixed length string (Private ISBN As String * 10) as variables if they could be used as parameters to or return values from functions (Function GetIsbn() As String * 10). I’m not sure I could live without integers (Long).

    I’m guessing that for you a Variant makes up for the intrinsic types’ woeful inadequacies because you can test it for IsMissing. I would agree that VBA6 is losing its appeal in these .NET times e.g. we have nullable types in C# now (http://blogs.msdn.com/somasegar/archive/2005/08/11/450640.aspx). But again, there must be some appeal to you for the status quo otherwise you would do all your development using VSTO, wouldn’t you?

    Back in VBA6, I find using an ADO recordset handy because I can leverage the nullabled data types SQLs need to support but I find I need to retain my Collections for the connivance of supporting enumerable collection classes. And this is where I came in.

    Jamie.

    –

18. Dick,

    your code is great. It has inspired many ideas in me. Thanks a lot for publishing.

Posting code? Use <pre> tags for VBA and <code> tags for inline.