i have a question about destroying object from standard and custom classes through array, here is example:
dim class1 As cClass1
dim class2 As cClass2
dim class3 As cClass3
....
Set class1 = New cClass1
Set class2 = New cClass2
Set class3 = New cClass3
....
after using them i want to destroy them at the end to release them from memory, but i want to avoid usage of
Set class1 = Nothing
Set class2 = Nothing
.... 'and so on
i want to destroy them with:
CRLS Array(class1, class2, class3, "and so on")
and here is sub that might do that:
Private Sub CLRS(ByRef arr As Variant)
Dim i As Integer
For i = 0 To UBound(arr)
If Not arr(i) Is Nothing Then
Set arr(i) = Nothing
Debug.Print "Deleted" 'it will throw "Deleted" but it will not delete element itself
Else
Debug.Print "not deleted" 'just to see status of element
End If
Next
Erase arr
End Sub
but unfortunately, if i check if "destroyed" elements are really free, answer is not, only copy of selected elements was set to nothing. objects are passed to array just as ByVal.
VBA destroys objects by using reference counters. When the object reference count is zero, the object gets destroyed. Say for your class1 variable you increase the counter by one by setting it in:
Set class1 = New cClass1
Then you pass the object to the array.
Array(class1, class2, class3, "and so on")
The object reference count becomes two because now the array has its own reference. Then you set the array reference to nothing and the count is one because class1 still has the reference.
Related
The problem: I would like to create a dynamic array that change size when an event occurs (Event Calculate), by preserving its content and extending by one its size. Let's say I want to do this for a vector of double (and also a date type). The data is updating in a specific cell.
My understanding: I am coding in the Event "Calculate of Excel". I cannot use "Public", I have to declare the array as private and then use Get and Let Property... But, how can I use Redim Preserve in this case ? Also, I think I am probably missing some points on how it has to be used: Here s a sample of the code I wrote:
Name of the Classe: "Class1"
Code of the class:
Code:
Option Explicit
Private IntradayValueSerie1() As Double 'Dynamic vector which will contain Y1 Values
Public Counter As Long
Public Property Let vIntradayValueSerie1(ByVal Counter_Value As Long)
IntradayValueSerie1(Counter_Value) = Sheets("Sheet1").Range("C5")
End Property
Public Property Get vIntradayValueSerie1(ByVal Counter_Value As Long) As Variant
vIntradayValueSerie1(Counterr) = IntradayValueSerie1
End Property
So I want "Let" To attribute the new value of my extended array
I want "Get" to return the array (extended and updated)
Remark: Counter will be updated and increase at then end of the in the section Event "Worksheet.Calculate"
Test code (HAS TO BE in the section Event "Worksheet.Calculate")
Code:
counter = 1
Dim Serie1 As New Class1
Serie1.IntradayValueSerie1(Counter) = ??? I don't know how to use the property to initialize the vector
counter = counter +1
ReDim Preserve IntradayValueSerie1(Counter)
Also, As I want to return an array, do I have to set Variant for the Get property ? As you can see, some points make me confused, either on the use and the structure.
Thank you for you time !
edited to match the following assumptions
a Sub in any of your modules initializes and uses a variable of Class1 type
I'll call it after Sub ExploitClass1(), but you can rename it as you like
that Sub writes into any cell of the relavant worksheet whose calculate event you want to use to update the dynamic array property of your variable of Class1 type
I'll assume that relevant worksheet is named after "CalculateClass": you can rename it as you like but be sure to fill its code pane with what you'll find in "your relevant worksheet code pane" section of this answer
then proceed like follows:
your Class1 code pane
Option Explicit
Private IntradayValueSerie1() As Double 'Dynamic array which will contain Y1 Values
Private counter As Long '<-- counter to track the size of the dynamic array
Public Sub WriteValue(ByVal Value As Variant) '<-- class method to write a value in the last dynamic array slot
IntradayValueSerie1(counter) = Value
Extend
End Sub
Private Sub Extend() '<-- class method to extend dynamic array size by one
counter = counter + 1 '<-- update the dynamic array size counter by one
ReDim Preserve IntradayValueSerie1(1 To counter) '<-- increase the dynamic array size
End Sub
Private Sub Class_Initialize()
counter = 1
ReDim IntradayValueSerie1(1 To counter) '<-- at class instantiating, initialize the dynamic array
End Sub
'-----------------------------------------------
' added methods to "query" some dynamic array related values
'-----------------------------------------------
Public Function GetCounter() As Long '<-- class method to retrive the current counter (i.e. the dynamic array size) value
GetCounter = counter '<-- return counter
End Function
Public Function GetPenultimateArrayValue() As Variant '<-- class method to retrive the current counter (i.e. the dynamic array size) value
GetPenultimateArrayValue = IntradayValueSerie1(counter - 1) '<-- return dynamic array one before second to last element
End Function
your Sub
Option Explicit
Public Serie1 As Class1 '<-- declare a Public variable of type Class1
Sub ExploitClass1()
Set Serie1 = New Class1 '<-- instantiate a new public object of type Class1
Worksheets("CalculateClass").Range("A1") = 1 ' make something that triggers calulate event in the relevant worksheet: in this case I had cell "A2" of that worksheet with a formula `= A1+1`
MsgBox Serie1.GetPenultimateArrayValue & " - " & Serie1.GetCounter 'show your Class1 dynamic array has been updated exploiting those "querying" methods we added at the bottom of your class
End Sub
your relevant worksheet code pane
it'll use the Public object of Class1 type we declared and initialized in ExploitClass1() sub
Option Explicit
Private Sub Worksheet_Calculate()
Serie1.WriteValue Worksheets("Sheet01").Range("C5").Value '<-- this will write the passed value to your class dynamic array last slot
End Sub
I'm not an experienced VBA programmer but I've been trying to create an Excel Spreadsheet that is able to manage a basketball team.
In it I've got a primary userform where I have declared an array, 'selectedPlayers'.
This primary userform has a for loop that starts up the secondary userform 'i' times.
I have not been able to access the primary userform's 'i' and 'selectedPlayers' from the secondary one.
I've been able to find a workaround the 'i' by creating a non-visible textbox in the first userform, that I'm able to reference from the second one.
I've tried declaring both of them as public, but yet I'm not able to call upon it from the second userform.
part of the code for the first userform:
i = 0
Do While Not i = Int(txtNumberPlayers)
frmGameDataSecondary.Show
i = i + 1
Loop
second userform:
Private Sub cmdDone_Click()
frmGameData.selectedPlayers(frmGameData.i) = lbxPlayer.Value
Unload Me
End Sub
Private Sub UserForm_Initialize()
With Me.lbxPlayer
For Each LR In LO.ListRows
exitSequence = False
For k = 1 To Int(frmGameData.txtNumberPlayers)
If frmGameData.selectedPlayers(k) = blablabla.Value Then
exitSequence = True
End If
Next k
If !exitSequence Then
.AddItem blablabla.Value
End If
Next LR
End With
End Sub
The main problem is that array contents are cleared after the sub is finished.
I was also messing around with this idea and there is a really good thread I started with tons of great information from various awesome people
Calling an Array Upon User Form Terminate/Close VBA
Forms in VBA are Objects, and can be treated like any other Class module. This means that you can add properties to them. If you need to pass information back from a form, all you need to do is grab a reference to it, then Hide it instead of Unload it. Treat it like a dialog and let the calling code handle it's create and destruction (I'm assuming from your code that it is modal).
Something like this:
In the first UserForm:
For i = 0 To 1
Dim second As frmGameDataSecondary
Set second = New frmGameDataSecondary
second.Show
'Execution suspends until the second form is dismissed.
selectedPlayers(i) = second.Player
Unload second
Next i
In the second UserForm:
Private mPlayer As String
'This is where your returned information goes.
Public Property Get Player() As String
Player = mPlayer
End Property
Private Sub cmdDone_Click()
mPlayer = lbxPlayer.Value
'Control passes back to the caller, but the object still exists.
Me.Hide
End Sub
You can declare properties inside of parent form which will manipulate the array from outside. The child form needs to have a reference to parent so it can call this properties. HTH
Parent form
Option Explicit
' I have not been able to access the primary userform's
' 'i' and 'selectedPlayers' from the secondary one
Private selectedPlayers As Variant
Public Function GetMyArrayValue(index) As Variant
GetMyArrayValue = selectedPlayers(index)
End Function
Public Sub SetMyArrayValue(index, newValue)
selectedPlayers(index) = newValue
End Sub
Private Sub UserForm_Click()
Dim i
i = 0
Do While Not i = Int(txtNumberPlayers)
With New secondaryUserForm
Set .ParentForm = Me
.SetIndex = i
.Show
End With
i = i + 1
Loop
End Sub
Private Sub UserForm_Initialize()
selectedPlayers = Array("A", "B", "C")
End Sub
Child form
Option Explicit
Private m_parent As primaryUserForm
Private m_index As Integer
Public Property Let SetIndex(ByVal vNewValue As Integer)
m_index = vNewValue
End Property
Public Property Set ParentForm(ByVal vNewValue As UserForm)
Set m_parent = vNewValue
End Property
Private Sub cmdDone_Click()
' frmGameData.selectedPlayers(frmGameData.i) = lbxPlayer.Value
m_parent.SetMyArrayValue m_index, "lbxPlayer.Value"
Unload Me
End Sub
I am trying to set the values of an array of Collections inside a For loop. However, when I go to run the program, it throws a compile error that states "Argument not optional" and highlights the part where I set the array value. When I go to debug the subroutine, I cannot get past the first line of ConvertbucketCollectionTobucketArray(). At that point, bucketArray elements 0 through 12 have a value of Nothing and bucketCollection contains 13 elements(1-13), where only several contain items.
Dim bucketCollection As New Collection 'the Collection of buckets
Dim bucketArray(12) As New Collection 'bucketCollection as an array
...
Private Sub ConvertbucketCollectionTobucketArray() 'debugger stops here
Dim newCol As Collection
Dim i As Integer
For i = 1 To bucketCollection.count
Set newCol = bucketCollection.Item(i)
bucketArray(i - 1) = newCol 'highlighted line here
Next
End Sub
Since collection is an object, you have to use set when copying it to an element (this is your error).
Set bucketArray(i - 1) = newCol
This will not cause an error, but an array doesn't need to be set as new.
Dim bucketArray(12) As Collection
And if bucketCollection is a classwide variable, you should separate creating a new instance and declaring it. Create a new instance of it in one of the functions. Otherwise, if you run the same code twice, it might use the same instance.
Sub test()
Set bucketCollection = New Collection
populate
ConvertbucketCollectionTobucketArray
End Sub
Please would someone who understands VBA Arrays (Access 2003) help me with the following code.
The idea is that ClassA holds a dynamic array of ClassB instances. The dynamic array starts empty. As callers call ClassA.NewB() then a new instance of ClassB is created, added to the array, and returned to the caller.
The problem is that I can't return the new instance of ClassB to the caller, but get "Runtime error 91: Object variable or With block variable not set"
Also, a little WTF occurs where UBound() fails but wrapping the exact same call in another function works!?!? (Hence MyUbound() )
I'm from a C++ background and this VBA stuff is all a bit strange to me!
Thanks for any help!
Main code:
Dim a As clsClassA
Dim b As clsClassB
Set a = New clsClassA
a.Init
Set b = a.NewB(0)
clsClassA:
Option Compare Database
Private a() As clsClassB
Public Sub Init()
Erase a
End Sub
Public Function NewB(i As Integer) As Variant
'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
If (MyUBound(a) < i) Then ' WORKS: Returns -1
ReDim Preserve a(0 To i)
End If
NewB = a(i) ' FAILS: Runtime error 91: Object variable or With block variable not set
End Function
Private Function MyUBound(a As Variant) As Long
MyUBound = UBound(a, 1)
End Function
clsClassB:
Option Compare Database
' This is just a stub class for demonstration purposes
Public data As Integer
Your approach stores a collection of ClassB instances in an array. For each instance you add, you must first ReDim the array. ReDim is an expensive operation, and will become even more expensive as the number of array members grows. That wouldn't be much of an issue if the array only ever held a single ClassB instance. OTOH, if you don't intend more than one ClassB instance, what is the point of storing it in an array?
It makes more sense to me to store the collection of instances in a VBA Collection. Collections are fast for this, and aren't subject to the dramatic slow downs you will encounter with an array as the number of items grows.
Here is a Collection approach for clsClassA.
Option Compare Database
Option Explicit
Private mcolA As Collection
Private Sub Class_Initialize()
Set mcolA = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolA = Nothing
End Sub
Public Function NewB(ByVal i As Integer) As Object
Dim objB As clsClassB
If i > mcolA.Count Then
Set objB = New clsClassB
mcolA.Add objB
Else
Set objB = Nothing
End If
Set NewB = objB
Set objB = Nothing
End Function
The only change I made to clsClassB was to add Option Explicit.
This procedure uses the class.
Public Sub test_ClassA_NewB()
Dim a As clsClassA
Dim b As clsClassB
Set a = New clsClassA
Set b = a.NewB(1) '' Collections are one-based instead of zero-based
Debug.Print TypeName(b) ' prints clsClassB
Debug.Print b.data '' prints 0
b.data = 27
Debug.Print b.data '' prints 27
Set b = Nothing
Set a = Nothing
End Sub
Try this:
Public Function NewB(i As Integer) As Variant
'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
If (MyUBound(a) < i) Then ' WORKS: Returns -1
ReDim Preserve a(0 To i)
End If
Set a(i) = New clsClassB
Set NewB = a(i)
End Function
You need to set a(i) to a new instance of the class (or it will simply be null), you also need to use Set as you're working with an object...
I'd perhaps also suggest changing the return type of NewB to clsClassB rather than Variant.
You could also do
Public Sub Init()
ReDim a(0 To 0)
Set a(0) = New Class2
End Sub
to remove the need for the special UBound function.
The UBound function throws this error when you try to use it on an array with no dimension (which is your case since you did an Erase on the array). You should have an error handler in your function to treat this case.
I use a special function to check if the array is empty, but you can just use parts of it for error handling.
Public Function IsArrayEmpty(ByRef vArray As Variant) As Boolean
Dim i As Long
On Error Resume Next
IsArrayEmpty = False
i = UBound(vArray) > 0
If Err.Number > 0 Then IsArrayEmpty = True
On Error GoTo 0
End Function
Also, if you still want to do an array then you could
redim preserve MyArray(lbound(MyArray) to ubound(MyArray)*2)
which will lesson the amount of times it redimensions, you would need a counter to redimension it at the very end.
Also, Dictionaries are supposed to be really fast (and more versatile than collections), they're like collections and you need to add a reference to Microsoft Scripting Runtime if you want to do dictionaries.
If arrays are returned by reference, why doesn't the following work:
'Class1 class module
Private v() As Double
Public Property Get Vec() As Double()
Vec = v()
End Property
Private Sub Class_Initialize()
ReDim v(0 To 3)
End Sub
' end class module
Sub Test1()
Dim c As Class1
Set c = New Class1
Debug.Print c.Vec()(1) ' prints 0 as expected
c.Vec()(1) = 5.6
Debug.Print c.Vec()(1) ' still prints 0
End Sub
You don't have a let property. Also, the get property is returning the entire array, rather than just the element in question. Change the return type of Property Get from Double() to just plain Double. Add Property Let. Note that it takes two inputs, but only one is passed to it. The last variable (MyValue, in this case) is assumed to get it's value from whatever is after the = sign. Put a break point somewhere early in Test1() and see how the values are affected in the Locals window. Compare the variables created by the original code versus my code:
'Class1 class module
Private v() As Double
Public Property Get Vec(index As Long) As Double
Vec = v(index)
End Property
Public Property Let Vec(index As Long, MyValue As Double)
v(index) = MyValue
End Property
Private Sub Class_Initialize()
ReDim v(0 To 3)
End Sub
' end class module
'Begin module
Sub Test1()
Dim c As Class1
Set c = New Class1
Debug.Print c.Vec(1) ' prints 0 as expected
c.Vec(1) = 5.6
Debug.Print c.Vec(1) ' prints 5.6
End Sub
'End module
In VBA, arrays are never returned by reference unless they are returned through a ByRef parameter. Furthermore, whenever you use = to assign an array to a variable, you've made a new copy of the array, even if you're assigning it to a ByRef argument inside of a procedure, so you're pretty much out of luck trying to make this work.
Some alternative are...
Use a VBA.Collection instead of an array.
Make your own class that encapsulates an array and exposes procedures for indirectly accessing and manipulating the internal array.
I want to suggest another nice way to do this using a Collection and a static Property without the need to use a class:
imagine you want to have the xlCVError enum as an array (or collection), e.g. to loop through it on errors and handle it based on the actual error.
The following is initialized once on access:
'from https://stackoverflow.com/a/56646199/1915920
Static Property Get XlCVErrorColl() As Collection
Dim c As Collection 'will be already initalized after 1st access
'because of "Static Property" above!
Set XlCVErrorColl = c
If Not c Is Nothing Then Exit Property
'initialize once:
Set c = New Collection
c.Add XlCVError.xlErrDiv0
c.Add XlCVError.xlErrNA
c.Add XlCVError.xlErrName
c.Add XlCVError.xlErrNull
c.Add XlCVError.xlErrNum
c.Add XlCVError.xlErrRef
c.Add XlCVError.xlErrValue
Set XlCVErrorColl = c
End Property
Turning this into an array or implementing it as an array is straight forward, but collections seem to be more useful to me, with the disadvantage that their elements are not implicitely typed/(compile-time-)type checked.
So this would e.g. turn it into an (read-only) array (with the in-mem-copy-disadvantage mentioned in other answers/comments):
'from https://stackoverflow.com/a/56646199/1915920
Static Property Get XlCVErrorArr() As XlCVError()
Dim a() As XlCVError
XlCVErrorArr = a
If UBound( a ) > 0 Then Exit Property
'initialize once:
Dim c As Collection: Set c = XlCVErrorColl
ReDim a(c.Count)
Dim i As Integer: For i = 1 To c.Count
a(i) = c(i)
Next i
XlCVErrorArr = a
End Function
So transforming the example from Clayton Ss answer into a static, modifiable module property using some array it would be:
'module (no class required)
'from https://stackoverflow.com/a/56646199/1915920
Private v() As Double
Static Property Get Vec(index As Long) As Double
If UBound(v) < 3 Then 'initialize once:
ReDim v(0 To 3) 'one could initialize it with anyting after here too
end if
Vec = v(index)
End Property
Public Property Let Vec(index As Long, MyValue As Double)
v(index) = MyValue
End Property