Reputation: 31
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 :).
Upvotes: 1
Views: 491
Reputation: 12612
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.
Upvotes: 0
Reputation: 579
@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?
Upvotes: 1
Reputation: 579
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.
Upvotes: 3