I have been getting into some object-oriented features of VB6. I've done lots of OOP with Java, and I'm trying to get this to work:
I have a array of Card objects, I want to check if an object in the index in the array has been created.
Dim cardsPlayer1(1 To 10) As Card
I created objects like this:
Set cardsPlayer1(index) = New Card
If tried using this to test if I have assigned an object to an index yet:
For counter = 1 To 10
If (cardsPlayer1(counter) Is Nothing) Then
Set cardsPlayer1(counter) = New Card
End If
Next counter
But it gave me a true value everytime and creating a new object to the whole array.
Here's the relevant code:
'Jordan Mathewson
'May 31, 2013
Dim cardsPlayer1(1 To 10) As Card
Dim cardsPlayer2(1 To 10) As Card
Private Sub cmdStartGame_Click()
Call addCard(1)
End Sub
'Called to add a card to one of the player's stacks
Private Sub addCard(player As Integer)
Dim counter As Integer
'To add a card to player1..
If (player = 1) Then
For counter = 1 To 10
If (cardsPlayer1(counter) Is Nothing) Then
Print "Object created." '<- Printed 10 times.
Set cardsPlayer1(counter) = New Card
End If
Next counter
'To add a card to player2..
Else
For counter = 1 To 10
If (cardsPlayer2(counter) Is Nothing) Then
Set cardsPlayer2(counter) = New Card
End If
Next counter
End If
Call refreshForm
End Sub
If I understand you correctly, the addCard sub should add one card but it adds all of them, when only called once. This isn't because it can't tell which array element is empty. It's just because it doesn't stop after successfully adding one.
For counter = 1 To 10
If (cardsPlayer1(counter) Is Nothing) Then
Set cardsPlayer1(counter) = New Card
Exit For ' <-- Add this
End If
Next counter
Without the Exit For, it will keep looping through the array and initialize the rest of it.
I suspect you might have a scoping issue. This gives me the expected results:
Sub Test()
Dim objectsArray(1 To 5) As TestObject
If objectsArray(1) Is Nothing Then
MsgBox "objectsArray(1) Is Nothing" ' <----- displayed
End If
Set objectsArray(1) = New TestObject
If objectsArray(1) Is Nothing Then
MsgBox "objectsArray(1) Is Nothing"
Else
MsgBox "Not objectsArray(1) Is Nothing" ' <----- displayed
End If
End Sub
Where do you declare objectsArray; where do you create the object; where is the loop? (Are these code snippets in different modules/class modules/functions?)
Related
I have a Client class. Inside that class there is an array losses. First I create and populate with clients a clientsColl array. Then for each client in that array I populate its losses array.
Then I try to print into debug a first element of losses for each client. However, it doesnt work and Property let procedure not defined and property get procedure did not return an object error appears.
And the same time if I just try to display a first element of losses for the first client, without any cycle, it works fine:
Dim clientsColl() As Client
clientsColl = getClients(dataWorkbook)
Dim clientCopy As Variant
Debug.Print "first: " & clientsColl(1).getLosses(1) 'works fine
For Each clientCopy In clientsColl
Debug.Print "in for each: " & clientCopy.getLosses(1) 'error here
Next
In Client class:
Public Property Get getLosses()
getLosses = losses
End Property
Private losses() As Double
How the losses array is populated:
Public Sub calculateFinancialResult()
ReDim losses(1 To simulationCount)
ReDim profits(1 To simulationCount)
Dim i As Long
For i = 1 To simulationCount
If outcomes(i) = 1 Then
losses(i) = totalLoss
...
Else
...
End If
Next
End Sub
Why does this happen and how to fix it?
EDIT: more of the main sub:
For Each clientCopy In clientsColl
clientCopy.setSimulationCount = globals("SIMULATION_COUNT")
...
clientCopy.calculateFinancialResult
...
Next
EDIT:
At the same time a simple for cycle works fine:
Debug.Print "first: " & clientsColl(1).getLosses(1)
For tempCount = LBound(clientsColl) To UBound(clientsColl)
Debug.Print "in for each: " & _
clientsColl(tempCount).getLosses(1)
Next
To conclude what was said in comments:
Your problem (error 451) often occures when you trying to compound properties.
To represent this case we can use any structure of any object with properties.
Let's emulate it with array of collections:
Option Explicit
Sub Test()
Dim Arr As Variant
Dim Col As Collection
Dim i As Long
Dim j As Long
ReDim Arr(1 To 10)
For i = 1 To 10
Set Col = New Collection
For j = 1 To 10
Call Col.Add(j)
Next
Set Arr(i) = Col
Next
On Error Resume Next
Debug.Print Arr(1).Item(1)
Debug.Print Arr(1).Item()(1)
On Error GoTo 0
End Sub
Your problem stems from the fact that you're treating your properties as attributes. On not-so-compounded (or when your array is declared explicitly as array of class instances) level it works due to early binding. But when things start to get more complex - it's fail, since your property just another function.
Hence, to achieve what you want, you should call it explicitly with another pair of parentheses.
Your getLosses property doesn't take an argument so your syntax is actually wrong, even though VBA can cope with it when early bound. You should be using:
Debug.Print "first: " & clientsColl(1).getLosses()(1) 'works fine
For Each clientCopy In clientsColl
Debug.Print "in for each: " & clientCopy.getLosses()(1) 'error here
Next
I also meet this problem when I create my customize array class using compound properties.
I solved it by adding class statment for return value in Property Get code. Just as what #Rory said.
You could try Public Property Get getLosses() As Double in the Client class.
I have Sheet1.ComboBox1 that I would like to fill with an array of values. This array is stored on Sheet2. This array is a list of all customers to be used in the excel file. All customers are listed in one single column.
Some customers appear more than once in the column. It varies by how many part numbers a customer has.
I would like to fill a Sheet1.ComboBox1 with this array, however, I don't want duplicate values.
I read online that I can convert the array into a collection which will automatically weed out duplicates.
I would like to take this collection and input it into the Sheet1.ComboBox1, however, upon some research, I've found that collections are read-only...(am I wrong in this conclusion?)
One strategy I saw was to convert the customer array into a collection and then back into a new simplified array. The hope is to store this new array into Sheet 3, then pull this array into ComboBox1.List. I've posted my code below of this attempt.
'Converts collection to an accessible array
Function collectionToArray(c As Collection) As Variant()
Dim a() As Variant: ReDim a(0 To c.Count - 1)
Dim i As Integer
For i = 1 To c.Count
a(i - 1) = c.item(i)
Next
collectionToArray = a
End Function
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long
CustomerArray() = Sheet2.Range("A5:A2000")
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
newarray = collectionToArray(ComboBoxArray)
Sheet3.Range("A1:A2000") = newarray
Sheet1.ComboBox1.List = Sheet3.Range("A1:2000")
I used ' CustomerArray() = Sheet2.Range("A5:2000") ' not because there are that many rows full of values in Sheet 2, rather, that I cover all bases when more customers are eventually added to the list. The total size of my Sheet 2 is currently A1:A110, but I want to future proof it.
When I run the code, the Array is successfully reduced and the new array is placed into Sheet3 with no duplicates. However, the first Customer entry is repeated after the last unique customer value is defined. (A46 is last unique customer, A47:A2000 its the same customer repeated)
Additionally, Sheet1.ComboBox1 remains empty.
Is anyone able to explain how to restrict the number of rows filled by 'collectionToArray' , instead of filling all 2000?
Also, where am I going wrong with filling the ComboBox1? Am I missing a command/function to cause the box to fill?
You don't need that function to make a New Array, seems Excessive to me.
Assigning to CustomerArray will take care of Future Additions in column
You can directly pass on the Collection value to ComboBox
You are missing On Error Goto 0 in your code after addition to Collection. That is making all to errors after that invisible and hard for you to identify which part of code is causing problems.
Here Try this:
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long
With Worksheets("Sheet2")
CustomerArray = .Range("A5:A" & .Range("A5").End(xlDown).row).Value
End With
On Error Resume Next
For i = LBound(CustomerArray) To UBound(CustomerArray)
ComboBoxArray.Add CustomerArray(i, 1), CustomerArray(i, 1)
Next
On Error GoTo 0
For Each Itm In ComboBoxArray
Worksheets("Sheet1").ComboBox1.AddItem Itm
Next
End Sub
First, you should assign your range dynamically to CustomerArray...
With Sheet2
CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
Then, you should disable error handling after you've finished adding the items to your collection. Since you did not do so, it hid the fact that your range reference in assigning the values to your listbox was incorrect, and that you didn't use the Value property to assign them. So you should disable the error handling...
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
On Error GoTo 0
Then, when transferring newarray to your worksheet, you'll need to transpose the array...
Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)
Then, as already mentioned, you should assign the items to your listbox with Sheet3.Range("A1:A2000").Value. However, since newarray already contains a list of the items, you can simply assign newarray to your listbox...
Sheet1.ComboBox1.List = newarray
So the complete code would be as follows...
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer As Variant
Dim CustomerArray() As Variant
Dim newarray() As Variant
With Sheet2
CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
On Error GoTo 0
newarray = collectionToArray(ComboBoxArray)
Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)
Sheet1.ComboBox1.List = newarray
End Sub
it could be achieved in a number of ways. using collection or dictionary object. i am just presenting simple method without going through collection or dictionary since only 5000 rows is to be processed. it could be further shortened if used directly with combo box without using OutArr. As #Domenic already answered it with explanations, may please go along with that solution.
Option Explicit
Sub test()
Dim InArr As Variant, OutArr() As Variant
Dim i As Long, j As Long, Cnt As Long
Dim have As Boolean
InArr = ThisWorkbook.Sheets("sheet2").Range("A5:A2000")
ReDim OutArr(1 To 1)
Cnt = 0
For i = 1 To UBound(InArr, 1)
If InArr(i, 1) <> "" Then
have = False
For j = 1 To UBound(OutArr, 1)
If OutArr(j) = InArr(i, 1) Then
have = True
Exit For
End If
Next j
If have = False Then
Cnt = Cnt + 1
ReDim Preserve OutArr(1 To Cnt)
OutArr(Cnt) = InArr(i, 1)
End If
End If
Next i
Sheet3.Range("A1").Resize(UBound(OutArr)).Value = Application.Transpose(OutArr)
Sheet1.ComboBox1.Clear
Sheet1.ComboBox1.List = OutArr
Debug.Print Sheet1.ComboBox1.ListCount
End Sub
I have a Client class. Inside that class there is an array losses. First I create and populate with clients a clientsColl array. Then for each client in that array I populate its losses array.
Then I try to print into debug a first element of losses for each client. However, it doesnt work and Property let procedure not defined and property get procedure did not return an object error appears.
And the same time if I just try to display a first element of losses for the first client, without any cycle, it works fine:
Dim clientsColl() As Client
clientsColl = getClients(dataWorkbook)
Dim clientCopy As Variant
Debug.Print "first: " & clientsColl(1).getLosses(1) 'works fine
For Each clientCopy In clientsColl
Debug.Print "in for each: " & clientCopy.getLosses(1) 'error here
Next
In Client class:
Public Property Get getLosses()
getLosses = losses
End Property
Private losses() As Double
How the losses array is populated:
Public Sub calculateFinancialResult()
ReDim losses(1 To simulationCount)
ReDim profits(1 To simulationCount)
Dim i As Long
For i = 1 To simulationCount
If outcomes(i) = 1 Then
losses(i) = totalLoss
...
Else
...
End If
Next
End Sub
Why does this happen and how to fix it?
EDIT: more of the main sub:
For Each clientCopy In clientsColl
clientCopy.setSimulationCount = globals("SIMULATION_COUNT")
...
clientCopy.calculateFinancialResult
...
Next
EDIT:
At the same time a simple for cycle works fine:
Debug.Print "first: " & clientsColl(1).getLosses(1)
For tempCount = LBound(clientsColl) To UBound(clientsColl)
Debug.Print "in for each: " & _
clientsColl(tempCount).getLosses(1)
Next
To conclude what was said in comments:
Your problem (error 451) often occures when you trying to compound properties.
To represent this case we can use any structure of any object with properties.
Let's emulate it with array of collections:
Option Explicit
Sub Test()
Dim Arr As Variant
Dim Col As Collection
Dim i As Long
Dim j As Long
ReDim Arr(1 To 10)
For i = 1 To 10
Set Col = New Collection
For j = 1 To 10
Call Col.Add(j)
Next
Set Arr(i) = Col
Next
On Error Resume Next
Debug.Print Arr(1).Item(1)
Debug.Print Arr(1).Item()(1)
On Error GoTo 0
End Sub
Your problem stems from the fact that you're treating your properties as attributes. On not-so-compounded (or when your array is declared explicitly as array of class instances) level it works due to early binding. But when things start to get more complex - it's fail, since your property just another function.
Hence, to achieve what you want, you should call it explicitly with another pair of parentheses.
Your getLosses property doesn't take an argument so your syntax is actually wrong, even though VBA can cope with it when early bound. You should be using:
Debug.Print "first: " & clientsColl(1).getLosses()(1) 'works fine
For Each clientCopy In clientsColl
Debug.Print "in for each: " & clientCopy.getLosses()(1) 'error here
Next
I also meet this problem when I create my customize array class using compound properties.
I solved it by adding class statment for return value in Property Get code. Just as what #Rory said.
You could try Public Property Get getLosses() As Double in the Client class.
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.