VBA Array Sort with Fieldname as Parameter

Question

Here's the deal...In trying to get past my fear of Class Modules in Excel VBA, I decided to create a class that is an array, then add functions (methods) for adding elements, sorting an instance, etc. Those are things I keep re-writing in normal modules as functions/subs but hope use of classes might be a step forward.

Code Module

Public Type Thing
   Name As String
   SomeNumber As Double
End Type

Class Module

Private pSomething() As Thing

This is followed by all the usual Public LETs and GETs, plus a function for inserting new values into the array. Then I get to the sorting function/method. There is no problem with sorting by Name or SomeNumber, but so far that takes two function/methods. I would like to parameterize into a single function/mehod then use an optional parameter to control which field is to be used. The following works, but it seems a bit clunky

Function SortByField(Optional FieldName As String, Optional SortOrder As vbaSortOrder)
    Dim strTemp As Thing
    If SortOrder = 0 Then SortOrder = soBottomToTop
    If Len(FieldName) = 0 Then FieldName = "Name"
    Dim i As Long
    Dim j As Long
    Dim lngMin As Long
    Dim lngMax As Long
    lngMin = LBound(pSomething)
    lngMax = UBound(pSomething)
    For i = lngMin To lngMax - 1
      For j = i + 1 To lngMax
        If IIf(SortOrder = soBottomToTop, _
                              IIf(FieldName = "Name", pSomething(i).Name > pSomething(j).Name, _
                                                       pSomething(i).SomeNumber > pSomething(j).SomeNumber), _
                              IIf(FieldName = "Name", pSomething(i).Name < pSomething(j).Name, _
                                                       pSomething(i).SomeNumber < pSomething(j).SomeNumber)) _
                              Then
          strTemp = pSomething(i)
          pSomething(i) = pSomething(j)
          pSomething(j) = strTemp
        End If
      Next j
    Next i
End Function

What I would like to do is replace the following (and it's peer in the second part of this gawdawful IF(IIF...) nonsense

IIf(FieldName = "Name", pSomething(i).Name > pSomething(j).Name, pSomething(i).SomeNumber > pSomething(j).SomeNumber)

...with something like this

"pSomething(i)." & FieldName > "pSomething(j)." & FieldName

Direct Question: How do I get the string to evaluate/convert to code?

Indirect Question: Is there some other technique to pass in a fieldname and have it treated as something other than a string?

Thanks in advance for any help, assistance, guidance, direction, references, advice this is a fool's errand, or derisive comments :).

Answer 1

BiggerDon, I was trying to follow your code and you are right the nested IIF are gawdawful. Can I suggest that you rewrite the code with SELECT CASE statements. That might help a bit. Further, what is the big objective you are trying to achieve? This almost looks like overkill for a single dimension array.

There might be other Excel VBA built in methods you can capitalize on.

I just did a quick internet search on sorting Arrays and came across Pearson's website http://www.cpearson.com/excel/SortingArrays.aspx

You might what to check it out.

Answer 2

@BiggerDon, How about a custom type class with a property for each of your fields. Loop through the records and add them to a collection of the custom class. When you do this you determine which field will be used as the key for the collection. Then use something like presented here. How do I sort a collection?

Answer 3

Consider an approach based on custom classes instead of types, and using Eval() method from VBScript to evaluate item's field value.

Place the code below in VBA Module:

Sub TestStorage()
    Dim Room As New Storage
    Dim i As Long
    Dim Elem As Object
    Dim Item As Variant
    Dim Result As String

    For i = 1 To 10
        Set Elem = New OrdinalType
        Elem.Name = GetRandomFruit
        Elem.Index = i
        Room.Push Elem
    Next
    For i = 11 To 20
        Set Elem = New ExtendedType
        Elem.Name = GetRandomFruit
        Elem.Index = i
        Elem.Additional = "Extended"
        Room.Push Elem
    Next
    Set Elem = Nothing

    ShowList Room.GetContent

    Room.SortByField "Name", True
    ShowList Room.GetContent

    Room.SortByField "Index", False
    ShowList Room.GetContent

End Sub

Sub ShowList(Arr)
    Result = ""
    For Each Item In Arr
        Result = Result & Item.Name & " (" & Item.Index & ")"
        If TypeName(Item) = "ExtendedType" Then
            Result = Result & " " & Item.Additional
        End If
        Result = Result & vbCrLf
    Next
    MsgBox Result
End Sub

Function GetRandomFruit()
    Dim Fruits
    Randomize
    Fruits = Array("Apple", "Apricot", "Banana", "Bilberry", "Blackberry", "Blackcurrant", "Blueberry", "Coconut", "Currant", "Cherry", "Cherimoya", "Clementine", "Date", "Damson", "Durian", "Elderberry", "Fig", "Feijoa", "Gooseberry", "Grape", "Grapefruit", "Huckleberry", "Jackfruit", "Jambul", "Jujube", "Kiwifruit", "Kumquat", "Lemon", "Lime", "Loquat", "Lychee", "Mango", "Mangostine", "Melon", "Cantaloupe", "Honeydew", "Watermelon", "Rock melon", "Nectarine", "Orange", "Passionfruit", "Peach", "Pear", "Plum", "Prune", "Pineapple", "Pomegranate", "Pomelo", "Raisin", "Raspberry", "Rambutan", "Redcurrant", "Satsuma", "Strawberry", "Tangerine", "Ugli Fruit")
    GetRandomFruit = Fruits(LBound(Fruits) + Round(Rnd * (UBound(Fruits) - LBound(Fruits))))
End Function

Add reference to Microsoft Script Control ActiveX (Menu - Tools - References).
Place the code below in VBA Class Module, Name Storage:

Private Content As Variant
Private SC As MSScriptControl.ScriptControl

Private Sub Class_Initialize()
    Set SC = New MSScriptControl.ScriptControl
    SC.Language = "VBScript"
    SC.ExecuteStatement "Function EvalProp(Item, Name): EvalProp = Eval(""Item."" & Name): End Function"
    Content = Array()
End Sub

Private Function GetValue(ObjectInstance, PropertyName)
    GetValue = SC.Run("EvalProp", ObjectInstance, PropertyName)
End Function

Public Sub Push(Item)
    ReDim Preserve Content(UBound(Content) + 1)
    Set Content(UBound(Content)) = Item
End Sub

Public Function Pop()
    Set Pop = Content(UBound(Content))
    ReDim Preserve Content(UBound(Content) - 1)
End Function

Public Sub SortByField(Optional PropName As String = "Name", Optional SortAsc As Boolean = True)
    Dim i As Long
    Dim j As Long
    Dim l As Long
    Dim u As Long
    Dim a As Variant
    Dim b As Variant
    Dim tmp As Object
    l = LBound(Content)
    u = UBound(Content)
    For i = l To u - 1
        For j = i + 1 To u
            a = GetValue(Content(i), PropName)
            b = GetValue(Content(j), PropName)
            If (a > b And SortAsc) Or (a < b And Not SortAsc) Then
                Set tmp = Content(j)
                Set Content(j) = Content(i)
                Set Content(i) = tmp
            End If
        Next j
    Next i
End Sub

Public Function GetContent()
    GetContent = Content
End Function

Public Function GetSize()
    GetSize = UBound(Content) - LBound(Content) + 1
End Function

Place the code below in VBA Class Module, Name OrdinalType:

Public Name As String
Public Index As Double

Place the code below in VBA Class Module, Name ExtendedType:

Public Name As String
Public Index As Double
Public Additional As String

This example shows how to create and store the instances of different types in the storage object which is able to process those types, in this particular case - to sort them taking a string as a sort field name. Note that such VBS injection is abnormal and generally it's not a best practice. Regarding processing speed - Function GetValue() call takes about 15 mksecs on my N7110.