TL;DR:
Is there any way to pass a class collection/list to a library sorting algorithm, and get it to return a sorted list (preferably by a named/default class property)?
I've recently been learning some Python, and was impressed by the Sorted() function, which can sort any iterable. For numbers this is straightforward, for classes however, it is possible to assign a comparison method like this. The method tells comparison operators how to compare 2 instances of the class. Amongst other things it allows you to use builtin sorting algorithms to sort a collection of the class.
In VBA I've been half successful in mimicking this. By setting a class' default member Attribute, you can use comparison operators (<,=,>=, etc.) on classes directly. Take the example class:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "defaultProp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private randVal As Single
Public Property Get DefaultValue() As Single
Attribute Value.VB_UserMemId = 0
DefaultValue = randVal
End Property
Private Property Let DefaultValue(ByVal value As Single)
randVal = value
End Property
Private Sub Class_Initialize()
DefaultValue = Rnd()
End Sub
Two instances of this class can be compared:
Dim instance1 As New defaultProp
Dim instance2 As New defaultProp
Debug.Print instance1.DefaultValue > instance2.DefaultValue
Debug.Print instance1 > instance2 'exactly equivalent, as the DefaultValue has the correct Attribute
And if I was implementing a VBA sort algorithm that can sort values, there should be no problem sorting classes by default value*. However I would prefer to use a builtin/library sorting algorithm (for the same reasons anyone would; clarity, efficiency, proper error handling etc.)
*One of these algorithms would work for that, although must be modified to switch the entire class round, not the value of it (by adding Sets)
Since VBA comparison operators have no issue, I assumed the same would be true for whatever the library was using. However when I tried with an ArrayList:
Sub testArrayList()
Dim arr As Object
Set arr = CreateObject("System.Collections.ArrayList")
' Initialise the ArrayList, for instance by generating random values
Dim i As Long
Dim v As defaultProp
For i = 1 To 5
Set v = New defaultProp
arr.Add v 'no problem here
Next i
arr.Sort 'raises an error
End Sub
I get an error
Failed to compare two elements in the array
So what's going on? Is it a flaw in my approach - is the default attribute not making it to the ArrayList? Or maybe the comparison operator in whatever language the library is written in is not as floopy-gloopy as the ones VBA and Python use? Any suggestions on more builtin sorting algorithms to try would be useful too!
It's not about the VBA comparison operators, ArrayList is a .NET class, so you're in the .NET world when you use it.
arr.Add v 'no problem here
You're adding instances of the defaultProp class; it doesn't matter that you have a default property on the type, .NET doesn't care about default properties. If you want to sort DefaultValue values, then do arr.Add v.DefaultValue or arr.Add (v) - then your ArrayList will contain items of type Single, which it knows how to sort.
In order for ArrayList.Sort to work with instances of your custom class, its items need to implement the IComparable interface, which is the case for System.Int32 (i.e. Long in VBA), System.String and every other primitive .NET types, and I think the VBA primitive types would indeed marshal correctly through .NET interop - but not custom classes.
Try adding a reference to mscorlib.tlb, and then in the defaultProp class module, specify this (you can't implement an interface that's defined in a late-bound library):
Implements IComparable
Then implement the interface - should look something like this (use the codepane dropdowns to make sure to get the correct signature - don't just copy-paste this snippet:
Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
Dim other As defaultProp
Set other = obj
' return Less than zero (-1) if this object
' is less than the object specified by the CompareTo method.
' return Zero (0) if this object is equal to the object
' specified by the CompareTo method.
' return Greater than zero (1) if this object is greater than
' the object specified by the CompareTo method.
End Function
Now that your custom class implements the interface ArrayList.Sort uses to determine how your defaultProp items relate to each other, I don't see a reason for it to fail.
IMO, you are abusing things by mixing things cross the boundaries. You're using VBA's default properties (something I generally perceive as a bad practice), then you're using .NET's ArrayList and trying to Sort it.
I think it would be much more logical to see if you can implement IComparable on the VBA class and then let the ArrayList use the IComparable interface to compare an object against other by however you want it to compare, without using any default properties hacked.
If you add the DefaultValue to the arr it would work:
Sub testArrayList()
'... code
For i = 1 To 5
Set v = New defaultProp
arr.Add v.DefaultValue
Next i
arr.Sort
End Sub
Obviously the implementation of .Sort of ArrayList is a bit strange and does not like comparing objects and their default values (could not find the implementation of the Sort() method). Although, this would work flawlessly:
For i = 1 To 5
Set v = New defaultProp
arr.Add v
Next i
Debug.Print arr(1) > arr(2)
This is a possible implementation of sorting, that would work for the arr object as expected. However, it is not part of the ArrayList library:
Public Function varBubbleSort(varTempArray As Object) As Object
Dim varTemp As Object
Dim lngCounter As Long
Dim blnNoExchanges As Boolean
Do
blnNoExchanges = True
For lngCounter = 0 To varTempArray.Count - 2
If varTempArray(lngCounter) > varTempArray(lngCounter + 1) Then
blnNoExchanges = False
Set varTemp = varTempArray(lngCounter)
varTempArray(lngCounter) = varTempArray(lngCounter + 1)
varTempArray(lngCounter + 1) = varTemp
End If
Next lngCounter
Loop While Not (blnNoExchanges)
Set varBubbleSort = varTempArray
On Error GoTo 0
Exit Function
End Function
But the sorting is ok:
Related
I am getting Runtime Error 13 when trying to update an object stored in a collection. Here is a minimal example.
The class (Class2) of the objects to be stored in the collection.
Option Explicit
Private pHasA As Boolean
Private pHasB As Boolean
Private pSomeRandomID As String
Property Get HasA() As Boolean
HasA = pHasA
End Property
Property Get HasB() As Boolean
HasB = pHasB
End Property
Property Let HasA(propValue As Boolean)
pHasA = propValue
End Property
Property Let HasB(propValue As Boolean)
pHasB = propValue
End Property
Property Let RandomID(propValue As String)
pSomeRandomID = propValue
End Property
Sub SetHasValues(key As String)
Select Case key
Case "A"
pHasA = True
Case "B"
pHasB = True
End Select
End Sub
Minimal code that reproduces the error:
Option Explicit
Private Sub TestCollectionError()
Dim classArray As Variant
Dim classCollection As Collection
Dim singleClass2Item As Class2
Dim iterator As Long
classArray = Array("A", "B", "C")
Set classCollection = New Collection
For iterator = LBound(classArray) To UBound(classArray)
Set singleClass2Item = New Class2
singleClass2Item.RandomID = classArray(iterator)
classCollection.Add singleClass2Item, classArray(iterator)
Next iterator
Debug.Print "Count: " & classCollection.Count
singleClass2Item.SetHasValues "A" ' <-- This code works fine.
Debug.Print "New Truth values: " & singleClass2Item.HasA, singleClass2Item.HasB
For iterator = LBound(classArray) To UBound(classArray)
classCollection(classArray(iterator)).RandomID = classArray(iterator)
classCollection(classArray(iterator)).SetHasValues classArray(iterator) '<-- Type mismatch on this line.
Next iterator
'***** outputs
'''Count: 3
'''New Truth values: True False
' Error dialog as noted in the comment above
End Sub
While the code above appears a little contrived, it is based on some real code that I am using to automate Excel.
I have searched for answers here (including the following posts), but they do not address the simple and non-ambiguous example that I have here. The answers that I have found have addressed true type mismatches, wrong use of indexing or similar clear answers.
Retrieve items in collection (Excel, VBA)
Can't access object from collection
Nested collections, access elements type mismatch
This is caused by the fact, that the parameter of your procedure SetHasValues is implicitely defined ByRef.
Defining it ByVal will fix your problem.
#ADJ That's annoying, but perhaps the example below will allow you to start making a case for allowing RubberDuck.
I've upgraded your code using ideas and concepts I've gained from the rubberduck blogs. The code now compiles cleanly and is (imho) is less cluttered due to fewer lookups.
Key points to note are
Not relying on implicit type conversions
Assigning objects retrieved from collections to a variable of the type you are retrieving to get access to intellisense for the object
VBA objects with true constructors (the Create and Self functions in class2)
Encapsulation of the backing variables for class properties to give consistent (and simple) naming coupled with intellisense.
The code below does contain Rubberduck Annotations (comments starting '#)
Updated Class 2
Option Explicit
'#Folder("StackOverflowExamples")
'#PredeclaredId
Private Type Properties
HasA As Boolean
HasB As Boolean
SomeRandomID As String
End Type
Private p As Properties
Property Get HasA() As Boolean
HasA = p.HasA
End Property
Property Get HasB() As Boolean
HasB = p.HasB
End Property
Property Let HasA(propValue As Boolean)
p.HasA = propValue
End Property
Property Let HasB(propValue As Boolean)
p.HasB = propValue
End Property
Property Let RandomID(propValue As String)
p.SomeRandomID = propValue
End Property
Sub SetHasValues(key As String)
Select Case key
Case "A"
p.HasA = True
Case "B"
p.HasB = True
End Select
End Sub
Public Function Create(ByVal arg As String) As Class2
With New Class2
Set Create = .Self(arg)
End With
End Function
Public Function Self(ByVal arg As String) As Class2
p.SomeRandomID = arg
Set Self = Me
End Function
Updated test code
Private Sub TestCollectionError()
Dim classArray As Variant
Dim classCollection As Collection
Dim singleClass2Item As Class2
Dim my_item As Variant
Dim my_retrieved_item As Class2
classArray = Array("A", "B", "C")
Set classCollection = New Collection
For Each my_item In classArray
classCollection.Add Item:=Class2.Create(my_item), key:=my_item
Next
Debug.Print "Count: " & classCollection.Count
Set singleClass2Item = classCollection.Item(classCollection.Count)
Debug.Print "Initial Truth values: " & singleClass2Item.HasA, singleClass2Item.HasB
singleClass2Item.SetHasValues "A" ' <-- This code works fine.
Debug.Print "New Truth values: " & singleClass2Item.HasA, singleClass2Item.HasB
For Each my_item In classArray
Set my_retrieved_item = classCollection.Item(my_item)
my_retrieved_item.RandomID = CStr(my_item)
my_retrieved_item.SetHasValues CStr(my_item)
Next
End Sub
The 'Private Type Properties' idea comes from a Rubberduck article encapsulating class variable in a 'This' type. My take on this idea is to use two type variable p and s (Properties and State) where p holds the backing variables to properties and s hold variables which represent the internal state of the class. Its not been necessary to use the 'Private Type State' definition in the code above.
VBA classes with constructors relies on the PredeclaredID attribute being set to True. You can do this manually by removing and saving the code, using a text editor to set the attributer to 'True' and then reimporting. The RUbberDuck attribute '#PredeclaredId' allows this to be done automatically by the RubberDuck addin. IN my own code the initialiser for class2 would detect report an error as New should not be used when Classes are their own factories.
BY assigning and intermediate variable when retrieving an object from a class (or even a variant) you give Option Explicit the best change for letting you n=know of any errors.
An finally the Rubberduck Code Inspection shows there are still some issues which need attention
my Excel-applicatin has a module with utility functions. One of them adds items to arrays:
Public Sub addToArray(ByRef arr As Variant, item As Variant)
'Sub adds one element to a referenced array
On Error Resume Next
Dim bd As Long
bd = UBound(arr)
If Err.Number = 0 Then
ReDim Preserve arr(bd + 1)
Else
ReDim Preserve arr(0)
End If
arr(UBound(arr)) = item
End Sub
This Sub works perfectly as long as I pass arrays that are not referenced as object members.
addToArray arr, item
works but...
addToArray myObject.arr, item
doesn't...
the second call adds the item to an array but loses the reference to myObject
I can write a workaround by implementing a method in each class (doesn't need object references because it accesses properties of the same object) but that's not how I wanted to solve this problem.
Pls hälp ;)
Unfortunately, this is not possible due to limitations of VBA.
When you're accessing a public variant field of an object, it's get copied by value, so the original reference is not exposed. And if you declared an array (which is internally a reference type) as a public field, you would get the compile error "Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules"
I have a class module called MyClass, with a public integer in it:
Public i as Integer
When I try to use this variable in a For loop like so:
Dim MyInstance as MyClass: Set MyInstance = New MyClass
For MyInstance.i = 1 To 10
Debug.Print "Hello"
Next
I get the error: Variable required. Can't assign to this expression
I have consulted the help page but cannot see how it applies to my case. The relevant fragment is: "You tried to use a nonvariable as a loop counter in a For...Next construction. Use a variable as the counter." But i is a variable after all, and not a Let Property function or any other expression.
What is wrong with the code?
EDIT: I should point out that the reason I want my iterator to be part of the class is that I have multiple instances of the class, serving different purposes in my project, and there are multiple nested For loops for each instance of the class. Therefore it is worth having the iterators belong to their respective objects, say:
For Client.i = 1 To Client.Count
For Order.i = 1 To Order.Count
For Item.i = 1 To Item.Count
etc.
I have settled for the following workaround but am still not entirely satisfied with it:
For ciii = 1 To Client.Count
Client.i = ciii ' Client.i is later used in the code
For oiii = 1 To Order.Count
Order.i = oiii
For iiii = 1 To Item.Count
Item.i = iiii
You cannot use MyInstance.i as the increment counter but you can use it as the terminator; e.g. For i = 1 To MyInstance.i.
MyClass class
Option Explicit
Public pi As Long
Public Property Get i() As Long
i = pi
End Property
Public Property Let i(Value As Long)
pi = Value
End Property
test sub procedure in Module1
Sub test()
Dim MyInstance As MyClass, i As Long
Set MyInstance = New MyClass
MyInstance.i = 10
For i = 1 To MyInstance.i
Debug.Print "Hello"
Next
End Sub
If you want a publicly accessible loop variable stick it at the top of a standard module i.e. declare the Public i at the top of a standard module.
Note that this would mean you need to re-write your standard module code as, as per point two, you are treating i as if it is a property/method of the class.
So, standard module code would be:
Public i As Long
Sub ........
For i = 1 To 10
Debug.Print "Hello"
Next i
End Sub ......
If you want it to somehow be a property/method then you need to define Getters and Setters (potentially) in the class. And then re-write your module code accordingly. Especially if you are planning on looping using i, you will need an incrementor method in the class.
And yes, I have changed i to Long as there are no advantages, in this case I believe, of having it declared as Integer. A Long is a safer bet for avoiding potential overflow.
If you need a workaround so that you iterate through a property of the instance, you could create a method to increment it, change your loop to a Do While ... Loop and call that method before the loop call.
'Class Module
Option Explicit
Public i As Integer
Public Sub increment_i()
i = i + 1
End Sub
Private Sub Class_Initialize()
i = 0
End Sub
'Module
Sub loop_myclass()
Dim instance As MyClass: Set instance = New MyClass
Do While instance.i <= 10
'Instance property dependent code here
Debug.Print instance.i
instance.increment_i
Loop
End Sub
OK, I found the answer. There is a Microsoft help page on For…Next loop regarding VB, but I think it pertains to VBA as well.
It says:
If the scope of counter isn't local to the procedure, a compile-time
warning occurs.
So there's not much to discuss here, it's just the way MS wants it to be. Though I'd think that if the scope is greater than the procedure it shouldn't cause any problems, but apparently it does.
I have to check a piece of user input against a list of items; if the input is in the list of items, then direct the flow one way. If not, direct the flow to another.
This list is NOT visible on the worksheet itself; it has to be obfuscated under code.
I have thought of two strategies to do this:
Declare as an enum and check if input is part of this enum, although I'm not sure on the syntax for this - do I need to initialise the enum every time I want to use it?
Declare as an array and check if input is part of this array.
I was wondering for VBA which is better in terms of efficiency and readability?
You can run a simple array test as below where you add the words to a single list:
Sub Main1()
arrList = Array("cat", "dog", "dogfish", "mouse")
Debug.Print "dog", Test("dog") 'True
Debug.Print "horse", Test("horse") 'False
End Sub
Function Test(strIn As String) As Boolean
Test = Not (IsError(Application.Match(strIn, arrList, 0)))
End Function
Or if you wanted to do a more detailed search and return a list of sub-string matches for further work then use Filter. This code would return the following via vFilter if looking up dog
dog, dogfish
In this particular case the code then checks for an exact match for dog.
Sub Main2()
arrList = Array("cat", "dog", "dogfish", "mouse")
Debug.Print "dog", Test1("dog")
Debug.Print "horse", Test1("horse")
End Sub
Function Test1(strIn As String) As Boolean
Dim vFilter
Dim lngCnt As Long
vFilter = Filter(arrList, strIn, True)
For lngCnt = 0 To UBound(vFilter)
If vFilter(lngCnt) = strIn Then
Test1 = True
Exit For
End If
Next
End Function
Unlike in .NET languages VBA does not expose Enum as text. It strictly is a number and there is no .ToString() method that would expose the name of the Enum. It's possible to create your own ToString() method and return a String representation of an enum. It's also possible to enumerate an Enum type. Although all is achievable I wouldn't recommend doing it this way as things are overcomplicated for such a single task.
How about you create a Dictionary collection of the items and simply use Exist method and some sort of error handling (or simple if/else statements) to check whether whatever user inputs in the input box exists in your list.
For instance:
Sub Main()
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
myList.Add "item1", 1
myList.Add "item2", 2
myList.Add "item3", 3
Dim userInput As String
userInput = InputBox("Type something:")
If myList.Exists(userInput) Then
MsgBox userInput & " exists in the list"
Else
MsgBox userInput & " does not exist in the list"
End If
End Sub
Note: If you add references to Microsoft Scripting Runtime library you then will be able to use the intelli-sense with the myList object as it would have been early bound replacing
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
with
Dim myList as Dictionary
Set myList = new Dictionary
It's up to you which way you want to go about this and what is more convenient. Note that you don't need to add references if you go with the Late Binding while references are required if you want Early Binding with the intelli-sense.
Just for the sake of readers to be able to visualize the version using Enum let me demonstrate how this mechanism could possibly work
Enum EList
item1
item2
item3
[_Min] = item1
[_Max] = item3
End Enum
Function ToString(eItem As EList) As String
Select Case eItem
Case EList.item1
ToString = "item1"
Case EList.item2
ToString = "item2"
Case EList.item3
ToString = "item3"
End Select
End Function
Function Exists(userInput As String) As Boolean
Dim i As EList
For i = EList.[_Min] To EList.[_Max]
If userInput = ToString(i) Then
Exists = True
Exit Function
End If
Next
Exists = False
End Function
Sub Main()
Dim userInput As String
userInput = InputBox("type something:")
MsgBox Exists(userInput)
End Sub
First you declare your List as Enum. I have added only 3 items for the example to be as simple as possible. [_Min] and [_Max] indicate the minimum value and maximum value of enum (it's possible to tweak this but again, let's keep it simple for now). You declare them both to be able to iterate over your EList.
ToString() method returns a String representation of Enum. Any VBA developer realizes at some point that it's too bad VBA is missing this as a built in feature. Anyway, you've got your own implementation now.
Exists takes whatever userInput stores and while iterating over the Enum EList matches against a String representation of your Enum. It's an overkill because you need to call many methods and loop over the enum to be able to achieve what a simple Dictionary's Exists method does in one go. This is mainly why I wouldn't recommend using Enums for your specific problem.
Then in the end you have the Main sub which simply gathers the input from the user and calls the Exists method. It shows a Message Box with either true or false which indicates if the String exists as an Enum type.
Just use the Select Case with a list:
Select Case entry
Case item1,item2, ite3,item4 ' add up to limit for Case, add more Case if limit exceeded
do stuff for being in the list
Case Else
do stuff for not being in list
End Select
I have defined a variable with an own type, say
Dim point As DataPoint
Public Type DataPoint
list as Collection
name as String
number as Integer
End Type
and I want to delete all values of the variable point at once. If it was a class, I would just use Set point = New DataPoint, or set Set point = Nothing, but how can I proceed if it's a type?
You can benefit from the fact that functions in VB have an implicit variable that holds the result, and that contains the default type value by default.
public function GetBlankPoint() as DataPoint
end function
Usage:
point = GetBlankPoint()
The standard way is to reset each member to its default value individually. This is one limitation of user-defined types compared to objects.
At the risk of stating the obvious:
With point
Set .list = Nothing
.name = ""
.number = 0
End With
Alternatively, you can create a "blank" variable and assign it to your variable each time you want to "clear" it.
Dim point As DataPoint
Dim blank As DataPoint
With point
Set .list = New Collection
.list.Add "carrots"
.name = "joe"
.number = 12
End With
point = blank
' point members are now reset to default values
EDIT: Damn! Beaten by JFC :D
Here is an alternative to achieve that in 1 line ;)
Dim point As DataPoint
Dim emptyPoint As DataPoint
Public Type DataPoint
list As Collection
name As String
number As Integer
End Type
Sub Sample()
'~~> Fill the point
Debug.Print ">"; point.name
Debug.Print ">"; point.number
point.name = "a"
point.number = 25
Debug.Print ">>"; point.name
Debug.Print ">>"; point.number
'~~> Empty the point
point = emptyPoint
Debug.Print ">>>"; point.name
Debug.Print ">>>"; point.number
End Sub
SNAPSHOT
One-liner:
Function resetDataPoint() As DataPoint: End Function
Usage:
point = resetDataPoint()
Another option is to use the reserved word "Empty" such as:
.number= Empty
The only issue is that you will need to change the number from integer to variant.
Using classes in VBA is usually a good practice in case it is not a single purpose solution or the class do not contain too many private attributes because if you want to adhere on OOP rules and keep your class safe, you should declare all the Let and Get properties for all private attributes of class. This is too much coding in case you have more than 50 private attributes. Another negative side of using classes in excel is fact, that VBA do not fully support the OOP. There is no polymorfism, overloading, etc.) Even you want to use an inheritance, you have to declare all the attributes and methods from the original class in the inherited class.
So in this case I would prefer the solution suggested by Jean-François Corbett or GSeng, i.e. to assign an empty variable of the same UDT as the variable you want to clear or to use a function which to me seems little bit more elegant solution because it will not reserve permanent memory for the emtpy variable of your UDT type.
For that is better to use classes, you can declare a class module with the name of your type, then declare all of your members as public, then automatically you can set to nothing and new for create and delete instances.
syntax will be somthing like this after you create the class module and named like your type:
'
Public List as Collection
Public Name as String
Public Number as Long
Private Sub Class_Initialize()
'Here you can assign default values for the public members that you created if you want
End Sub