I have some problems with an array in VBScript: I have a central array, in this I save some custom objects. Later on, I want access these elements to print out the objects. But this don't work.
Here is my code;
sub start
redim selektionsArray(0)
for i = 0 to 10
Dim TheDude : Set TheDude = (New Selektion2)("a" & i, "b" & i)
ReDim Preserve selektionsArray(ubound(selektionsArray) + 1)
set selektionsArray(ubound(selektionsArray)) = TheDude
'Works
msgbox selektionsArray(ubound(selektionsArray)).Typ & " = " & selektionsArray(ubound(selektionsArray)).Wert
next
dim i
for i = 0 to ubound(selektionsArray)
set element3 = selektionsArray(i)
'don't work
msgbox selektionsArray(i).Typ & " = " & selektionsArray(i).Wert
next
dim sel
for each sel in selektionsArray
'don't work to
msgbox sel.Wert
next
'strange thing is ubound(selektionsArray) --> 11
end sub
Class Selektion2
Private m_typ
Private m_wert
Public Default Function Init(Typ, Wert)
m_typ = Typ
m_wert = Wert
Set Init = Me
End Function
Public Property Get Typ
Typ = m_typ
End Property
Public Property Get Wert
Wert = m_wert
End Property
public function getWert()
getWert = m_wert
end function
End Class
I don't can access the array-Elements outside the initialisation loop, what is here wrong?
Your error is to assume that
redim selektionsArray(0)
creates an empty array. It does not, the array has an empty first element at index 0. Adding further objects is no problem, but when you try to
set element3 = selektionsArray(i)
for i = 0, or to access the firs sel in the For Each loop, that empty element can't be use to Set the/a variable. So change the 'create my array' statement to
redim selektionsArray(-1)
Related
I have an Array of user defined Objects. Lets say the classy, dogs.
Now I need a way to only look at all brown dogs with spots (both attributes of the Object).
I could create a new array "brown dogs" go through the original array take each dog that has brown fur and pack him in the new array. Then do another array "brown, spotted dogs" and so on you get the idea...
Works but isnt really great.
But I actually need to look at all dogs with each possible color, so all brown dogs in a group, all white dogs etc. And then create further sub groups based on further attributes.
It would be easy in an excel sheet, just filter for brown, and the other attribute, then ran the macro you want, then (by hand) filter to another color, ran code again...
I have a construct in mind that could do that in theory (take value of first attribute, create "already done colors" array, put it in their, go through whole original array, find all with the same color and then do this over and over again for all subsequent attributes) But this would be just very complexe, and hard to maintain. Isnt their an easier and quicker option to only a specific subset of values of the array (brown dogs) and repeat it for all permutations of that attribute?
Maybe this picture helps to illustrate the idea:
The basic challange is: find if the the combination of b-z (in column 2 and 3) exists for each group of column 1.
A human sees quiet quickly that for group "1" (blue) in column 1 there are 2 cases of b-z (Rows 5 and 7) but none for group "2" (green).
A programm would need to find all instances where column one is of the first value ("2") and then find all other rows with this value (rows 2,5 and 6) then for this list check column 2 and 3.
Go to the next row and check if attribute 1 was already used (it wasnt, its "1" in line two and was "2" in line one) and then compare again.
This may be doable for the given example but gets burdensome when you have several stages of grouping. So first group for Attribute one, then for ( a hyphotetical) attribute 4 and attribute 5 and then for this sub group check columns 2 an d 3 values.
Iam now looking for a way to do this "grouping" in a more managable way, is there any option for this?
Code example for what I think is a not so great version for grouping/filtering this:
dim ArrayofObjectInstances() as SpecificObject
dim ArrAlreadyUsedIds() as integer
dim ArrayOfObjectsWithSameID() as SpecificObject
For each element in ArrayofObjectInstances
If not IsinArray(elemnt.ID, ArrAlreadyUsedIds) then
For i = 1 to LenghtOfArray
if ArrayofObjectInstances(i).ID Like element.ID then
'In here I would start the for each and the for loop again for a second Attribute I want to group by, and then again for a third, each time needing more arrays
'fill the "ArrayOfObjectsWithSameID" with the current element (and the first one), then lopp through this array and check 2 Attributes if they are spevific values,
'just to then be able to say, yes the grouping for this ID has at least one instance where the reuirment is meet
end if
next
end if
next element
One way to go:
Test class clsTest:
Option Explicit
Public Id As Long
Public Color As String
Public Weight As String
Public Attitude As String
'added this for Debug output
Public Property Get AsString()
AsString = Join(Array(Me.Id, Me.Color, Me.Weight, Me.Attitude), "~")
End Property
Test code:
Option Explicit
Sub Tester()
Dim i As Long, obj As clsTest, col As New Collection
'create a collection of test objects with randomized property values
For i = 1 To 10
Set obj = New clsTest
obj.Id = i
obj.Color = Array("Blue", "Brown", "Yellow") _
(Application.RandBetween(0, 2))
obj.Weight = Array("Heavy", "Light")(Application.RandBetween(0, 1))
obj.Attitude = Array("Good", "Bad")(Application.RandBetween(0, 1))
col.Add obj
Next i
DumpNestedDict Classify(col, Array("Color"))
DumpNestedDict Classify(col, Array("Color", "Weight"))
DumpNestedDict Classify(col, Array("Weight", "Color", "Attitude"))
End Sub
'Classify a collection of objects according to an array of property names
'Returns a scripting dictionary (nested if >1 property) with objects
' contained in one or more collections
Function Classify(col, arrProps)
Dim dict As Object, pv, i As Long, curr As Object, obj As Object
Set dict = CreateObject("scripting.dictionary")
For Each obj In col
Set curr = dict 'start at the top level...
For i = LBound(arrProps) To UBound(arrProps)
pv = CallByName(obj, arrProps(i), VbGet) 'get the property value
If Not curr.exists(pv) Then
If i < UBound(arrProps) Then 'at the last property?
'not at last property, so create a nested dictionary
curr.Add pv, CreateObject("scripting.dictionary")
Else
'end of the road is a collection of objects
curr.Add pv, New Collection 'end of the road is a collection of objects
End If
End If
If i < UBound(arrProps) Then Set curr = curr(pv) 'one level down in the nesting
'last property, so add the object itself
If i = UBound(arrProps) Then
curr(pv).Add obj
End If
Next i
Next obj
Set Classify = dict
End Function
'create a text output from a nested dictionary containing collections of objects
' object must have an "AsString" property
Sub DumpNestedDict(d As Object, Optional level As Long = 0)
Dim k, v, s, obj
s = String(level * 3, " ")
For Each k In d.Keys
Debug.Print s & "Key:" & k
If TypeName(d(k)) = "Dictionary" Then
DumpNestedDict d(k), level + 1
ElseIf TypeName(d(k)) = "Collection" Then
For Each obj In d(k)
Debug.Print String((level + 1) * 3, " ") & obj.AsString
Next obj
End If
Next k
If level = 0 Then Debug.Print "---------------------------", vbLf
End Sub
Example output:
Key:Yellow
1~Yellow~Light~Good
3~Yellow~Light~Bad
4~Yellow~Heavy~Good
6~Yellow~Light~Bad
10~Yellow~Heavy~Good
Key:Brown
2~Brown~Light~Bad
7~Brown~Heavy~Bad
8~Brown~Heavy~Bad
Key:Blue
5~Blue~Heavy~Bad
9~Blue~Light~Good
---------------------------
Key:Yellow
Key:Light
1~Yellow~Light~Good
3~Yellow~Light~Bad
6~Yellow~Light~Bad
Key:Heavy
4~Yellow~Heavy~Good
10~Yellow~Heavy~Good
Key:Brown
Key:Light
2~Brown~Light~Bad
Key:Heavy
7~Brown~Heavy~Bad
8~Brown~Heavy~Bad
Key:Blue
Key:Heavy
5~Blue~Heavy~Bad
Key:Light
9~Blue~Light~Good
---------------------------
Key:Light
Key:Yellow
Key:Good
1~Yellow~Light~Good
Key:Bad
3~Yellow~Light~Bad
6~Yellow~Light~Bad
Key:Brown
Key:Bad
2~Brown~Light~Bad
Key:Blue
Key:Good
9~Blue~Light~Good
Key:Heavy
Key:Yellow
Key:Good
4~Yellow~Heavy~Good
10~Yellow~Heavy~Good
Key:Blue
Key:Bad
5~Blue~Heavy~Bad
Key:Brown
Key:Bad
7~Brown~Heavy~Bad
8~Brown~Heavy~Bad
---------------------------
Please, test the next code. I tried commenting it in a way to be understandable for somebody not familiar with dictionaries handling:
Sub testDictionariyWay()
'it needs a reference to 'Microsoft Scripting Runtime'
'The code may use late binding, but not being experienced in dictionary using, adding this reference
'you will have access to intellisense suggestions. I will also place a piece of code able to put it automatically...
Dim sh As Worksheet, arr, arrOb, dict As New Scripting.Dictionary
Dim i As Long, j As Long, boolExisting As Boolean
Set sh = ActiveSheet
arr = sh.Range("A2:C7").value 'put the range to be processed in an array (only to make the code faster and more compact)
For i = 1 To UBound(arr)
If Not dict.Exists(arr(i, 2)) Then 'if the attribute does not exist like a dictionary key:
dict.Add arr(i, 2), Array(arr(i, 1)) 'a key is created and an array of one element is placed like its value
Else
ReDim arrOb(UBound(dict(arr(i, 2))) + 1) 'redim an array able to keep all precedent array elements, plus one to be added
For j = 0 To UBound(arrOb) - 1 'iterate between the existing array elements:
If dict(arr(i, 2))(j) <> arr(i, 1) Then 'check if the object is not already in the array:
arrOb(j) = dict(arr(i, 2))(j) 'if not, it will be placed in the new array
Else
boolExisting = True: Exit For 'if the object already exists, the loop is exited and a boolean variable becomes True
End If
Next j
If Not boolExisting Then 'if not the object already exist:
arrOb(j) = arr(i, 1) 'place the new object in the last array element
dict(arr(i, 2)) = arrOb 'add the array as dictionary key value
End If
boolExisting = False 'reinitialize he boolean variable
End If
'do the same for the third column:
If Not dict.Exists(arr(i, 3)) Then
dict.Add arr(i, 3), Array(arr(i, 1))
Else
ReDim arrOb(UBound(dict(arr(i, 3))) + 1)
For j = 0 To UBound(arrOb) - 1
If dict(arr(i, 3))(j) <> arr(i, 1) Then
arrOb(j) = dict(arr(i, 3))(j)
Else
boolExisting = True: Exit For
End If
Next j
If Not boolExisting Then
arrOb(j) = arr(i, 1)
dict(arr(i, 3)) = arrOb
End If
boolExisting = False
End If
Next i
'testing the dictionary content. Now, being a strings array, Debug.Print can be used.
'Otherwise, an object will be returned and it should be Set and use one of its attributes to check the code:
Dim El As Variant
For Each El In dict("a")
Debug.Print "a: " & El
Next El
For Each El In dict("x")
Debug.Print "x: " & El
Next El
End Sub
The next piece of code will automatically add the necessary reference. Please, first run the following code, save the workbook (to keep the reference) and then run the above one:
Sub addScrRunTimeRef()
'Add a reference to 'Microsoft Scripting Runtime':
'In case of error ('Programmatic access to Visual Basic Project not trusted'):
'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
' check "Trust access to the VBA project object model"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
End Sub
Edited to add a variant involving a class and its instances, to be more elocvent (at least, this is what I hope):
Create a class module, named 'clsFoo' and paste the next code:
Option Explicit
Private pmyName As String
Private pmyColor As String
Private pmyTag As String 'to identify the class Object instance (string) name...
Public Property Get myName() As String
myName = pmyName
End Property
Public Property Let myName(value As String)
pmyName = value
End Property
Public Property Get myColor() As String
myColor = pmyColor
End Property
Public Property Let myColor(value As String)
pmyColor = value
End Property
Public Property Get myTag() As String
myTag = pmyTag
End Property
Public Property Let myTag(value As String)
pmyTag = value
End Property
Try the next code showing how to create dictionaries for both class properties:
Sub testClassInstancesInDict()
Dim arrFoo(4), Foo1 As New clsFoo, Foo2 As New clsFoo, Foo3 As New clsFoo, Foo4 As New clsFoo, Foo5 As New clsFoo
Dim El As Variant, dictName As New Scripting.Dictionary, dictColor As New Scripting.Dictionary, arrClss() As clsFoo, i As Long
Foo1.myName = "Name1": Foo1.myColor = "red": Foo1.myTag = "Foo1": Set arrFoo(0) = Foo1
Foo2.myName = "Name2": Foo2.myColor = "black": Foo2.myTag = "Foo2": Set arrFoo(1) = Foo2
Foo3.myName = "Name1": Foo3.myColor = "green": Foo3.myTag = "Foo3": Set arrFoo(2) = Foo3
Foo4.myName = "Name4": Foo4.myColor = "black": Foo4.myTag = "Foo4": Set arrFoo(3) = Foo4
Foo5.myName = "Name1": Foo5.myColor = "white": Foo5.myTag = "Foo5": Set arrFoo(4) = Foo5
For Each El In arrFoo
'process dictName dictionary:
If Not dictName.Exists(El.myName) Then
dictName.Add El.myName, Array(El)
Else
ReDim arrClss(UBound(dictName(El.myName)) + 1)
For i = 0 To UBound(dictName(El.myName))
Set arrClss(i) = dictName(El.myName)(i)
Next i
Set arrClss(i) = El: dictName(El.myName) = arrClss
End If
'process dictColor dictionary:
If Not dictColor.Exists(El.myColor) Then
dictColor.Add El.myColor, Array(El)
Else
ReDim arrClss(UBound(dictColor(El.myColor)) + 1)
For i = 0 To UBound(dictColor(El.myColor))
Set arrClss(i) = dictColor(El.myColor)(i)
Next i
Set arrClss(i) = El: dictColor(El.myColor) = arrClss
End If
Next
'test the resulted dictionaries:
Debug.Print "DictName Name1 key has " & UBound(dictName("Name1")) & " clsFoo objects"
Debug.Print "DictColor black key has " & UBound(dictColor("black")) & " clsFoo objects"
Dim j As Long
'all dictName keys/items. myTag returns the object string name:
Debug.Print "dictName _________________________"
For j = 0 To dictName.count - 1
For i = 0 To UBound(dictName.items(j))
Debug.Print "KeyName: " & dictName.Keys(j) & vbTab & dictName.items(j)(i).myName & _
vbTab & dictName.items(j)(i).myColor & vbTab & dictName.items(j)(i).myTag
Next i
Next
'all dictColor keys/items:
Debug.Print: Debug.Print "dictColor ________________________"
For j = 0 To dictColor.count - 1
For i = 0 To UBound(dictColor.items(j))
Debug.Print "KeyColor: " & dictColor.Keys(j) & vbTab & dictColor.items(j)(i).myName & _
vbTab & dictColor.items(j)(i).myColor & vbTab & dictColor.items(j)(i).myTag
Next i
Next
End Sub
I'm attempting to practice arrays by creating something where a user can create the list of items for a shop. I want the item names to go to a list box and an array that will be parallel to an array that holds the price and quantity of the item. I also want the user to be able to check the price and quantity of the item by selecting the item in the list box and pressing the check item button. The program crashes when I attempt to use the check item button.
Here is the part where the user adds in their item.
Private Sub btnAdd_click(sender As Object, e As EventArgs) Handles btnAdd.Click
addName = InputBox("What is the name of the product you wish to add?")
addPrice = InputBox("What is the price of the product?")
addQuantity = InputBox("What is the quantity in stock of the product?")
lstStock.Items.Add(addName)
End Sub
I added the items into the array and I hope I set it up to where it will automatically create the array regardless of length. I believe this may be creating an infinite loop that freezes the program.
Public Sub added(ByRef addlist As String, ByRef addPQ As String)
Dim nameID As Double = lstStock.Items.Count
Dim lstCount As Double = lstStock.Items.Count
Dim lstArrayCount As Double = 0
Dim num As Double
Dim lstNum As String
While lstArrayCount < 1
lstNum = addName
lstArrayCount = +1
End While
While lstArrayCount < lstCount
lstNum = lstNum & addName & "}, {"
lstArrayCount = +1
End While
Dim priceQuantityCount As Double
Dim lstPrice As String
While priceQuantityCount < 1
lstPrice = lstPrice & addPrice & ", " & addQuantity & "}"
priceQuantityCount = +1
End While
While priceQuantityCount > 1 And priceQuantityCount < lstCount
lstPrice = lstPrice & ", {" & addPrice & ", " & addQuantity & "}"
priceQuantityCount = +1
End While
Dim List() As String = {lstNum}
Dim PriceQuantity(,) As String = {{lstPrice}}
addlist = List.ToString()
addPQ = PriceQuantity.ToString()
End Sub
everything freezes when the button is pressed. I put this bit in here just in case. Nothing visual happens except the program freezes and the cpu usage jumps up. No error messages or anything like that.
Private Sub btnCheck_Click(sender As Object, e As EventArgs) Handles btnCheck.Click
Dim check As String = lstStock.SelectedItem.ToString()
Dim add1 As String
Dim add2 As String
added(add1, add2)
Dim strPrice As String
Dim strQuantity As String
Dim PQArray As String
Dim intIndex As Integer
PQArray = add2
intIndex = PQArray.IndexOf("")
If intIndex <> -1 Then
strPrice = PQArray.Substring(0, intIndex)
strQuantity = PQArray.Substring(intIndex + 1)
End If
MessageBox.Show("there are " & "quantity" & " " & check & " in stock priced at $" & "price" & " each.")
MessageBox.Show(strPrice & " : " & strQuantity)
End Sub
End Class
Let's start with the three arrays.
A Name array. This will be persisted in the list box itself. The ListBox.Items is an array of Object.
A Price array at the Form level. This should be of type Decimal - good to use for money things.
Private PriceArray(10) As Decimal
A Quantity array at the Form level. This should be of type Integer, whole numbers of in stock items.
Private QuantityArray(10) As Integer
Now let's look at your Add method.
Private Sub btnAdd_click(sender As Object, e As EventArgs) Handles btnAdd.Click
Dim addName = InputBox("What is the name of the product you wish to add?")
Dim addPrice = InputBox("What is the price of the product?")
Dim addQuantity = InputBox("What is the quantity in stock of the product?")
ListBox1.Items.Add(addName)
PriceArray(CurrentIndex) = CDec(addPrice)
QuantityArray(CurrentIndex) = CInt(addQuantity)
CurrentIndex += 1
End Sub
I changed your 3 variables to local variables (added Dim). I changed the name of the listbox so it would work in my test project. I added the Name to the list box just as you did. The first time this button is clicked the name is add to the Items collection at index 0. I added another form level variable, CurrentIndex. This will keep track of where we are in the arrays. The first time through CurrentIndex is initialized by default to 0. We use Current Index as the index where we fill in the inputted value. Next time we add we need to increment CurrentIndex to the next index.
CurrentIndex += 1
I think you tried to do this but you had the syntax a bit wrong. It is += ; you had = +1 which will just assign 1 to the variable.
Let's think where we are. The name in the list box has an index that matches the index in the price array and the quantity array. The arrays are parallel (concurrent).
To get the information back from our arrays I used the SelectedIndexChanged event.
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.SelectedIndexChanged
Dim IndexSelected = ListBox1.SelectedIndex
TextBox1.Text = PriceArray(IndexSelected).ToString("N2")
TextBox2.Text = QuantityArray(IndexSelected).ToString
End Sub
We can get the index with the .SelectedIndex property. We use that index to find the matching values in the PriceArray and the QuantityArray. The "N2" after .ToString for the PriceArray tells it to display a number with 2 decimal places.
I have the next code:
Function findRanges(keyword) As Variant()
Dim foundRanges(), rngSearch As Range
Dim i, foundCount As Integer
i = 0
foundCount = 0
ReDim foundRanges(0)
Set rngSearch = ActiveDocument.Range
Do While rngSearch.Find.Execute(FindText:=keyword, MatchWholeWord:=True, Forward:=True) = True
Set foundRanges(i) = rngSearch.Duplicate
i = i + 1
ReDim Preserve foundRanges(UBound(foundRanges) + 1)
rngSearch.Collapse Direction:=wdCollapseEnd
Loop
ReDim Preserve foundRanges(UBound(foundRanges) - 1)
findRanges = foundRanges
End Function
And:
Sub test()
Dim rngIAM_Code() As Range
...
Dim rngIAM_Title() As Range
rngIAM_Code = findRanges("IAM_Code")
...
rngIAM_Title = findRanges("IAM_Title")
End Sub
What is very confuding is that sometimes the compiler says "Can't assign to array" and sometimes it works fine. For example, when I only try to search one value and populate one array, the code works. When I try to populate both array, there is an error "Can't assign to an array". I can then switch lines of code like this:
rngIAM_Title = findRanges("IAM_Title")
...
rngIAM_Code = findRanges("IAM_Code")
And then the error happens with another array. The error can happen anywhere: on the first line, in the middle, or in the end, but it is consistent as long as I don't move lines. And again, if I leave only one-two lines of code with arrays in sub "test"everything works fine.
The following works for me.
In this code, every object variable is explicitly assigned a type. In VBA, every variable must be typed, else it's assigned the type Variant by default. In the following declaration line, for example, foundRanges() is of type Variant because it's not followed by As with a data type. The same with i in the next line of code in the question.
Dim foundRanges(), rngSearch As Range
And since the arrays in the calling procedure are of type Range the function should return the same type.
I also took the liberty of passing the Document object to the function as, conceivably, some day the document in question might not be ActiveDocument but a Document object assigned using Documents.Open or Documents.Add. If this is not desired it can be changed back, but not relying on ActiveDocument is more reliable...
Additionally, I added the Wrap parameter to Find.Execute - it's always a good idea to specify that when executing Find in a loop to prevent the search from starting again at the beginning of the document (wdFindContinue).
Sub testRangesInArrays()
Dim rngIAM_Code() As Range
Dim rngIAM_Title() As Range
rngIAM_Code = findRanges("You", ActiveDocument)
rngIAM_Title = findRanges("change", ActiveDocument)
End Sub
Function findRanges(keyword As String, doc As Word.Document) As Range()
Dim foundRanges() As Range, rngSearch As Range
Dim i As Integer, foundCount As Integer
i = 0
foundCount = 0
ReDim foundRanges(0)
Set rngSearch = doc.content
Do While rngSearch.Find.Execute(findText:=keyword, MatchWholeWord:=True, _
Forward:=True, wrap:=wdFindStop) = True
Set foundRanges(i) = rngSearch.Duplicate
ReDim Preserve foundRanges(UBound(foundRanges) + 1)
i = i + 1
rngSearch.Collapse Direction:=wdCollapseEnd
Loop
findRanges = foundRanges
End Function
Here is an alternative based on a Collection instead of an Array:
I used also included Cindys Input regarding passing the document and adding wrap.
I don't exactly know what the you use the return value for, but in general a collection is a bit more flexible than an Array.
I also removed the underscores since they indicate a function of an implemented Interface and may cause problems later down the line. are used when implementing an Interface (improves readability).
As explained here you can use wrap or collapse to prevent a continuous Loop.
Option Explicit
Sub test()
Dim rngIAMCode As Collection
Dim rngIAMTitle As Collection
Set rngIAMCode = findRanges("IAM_Code", ActiveDocument)
Set rngIAMTitle = findRanges("IAM_Title", ActiveDocument)
Debug.Print "Code found : " & rngIAMCode.Count & " Times."
Debug.Print "Title found : " & rngIAMTitle.Count & " Times."
End Sub
Function findRanges(ByVal keyword As String, doc As Document) As Collection
Set findRanges = New Collection
Dim rngSearch As Range
Set rngSearch = doc.Content
With rngSearch.Find
.Text = keyword
.MatchWholeWord = True
.Forward = True
.Wrap = wdFindStop
While .Execute
findRanges.Add rngSearch.Duplicate
rngSearch.Collapse Direction:=wdCollapseEnd
Wend
End With
End Function
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'm trying to loop through a listbox and add the contents to an array....
My code is this:
Private Sub exportfolders_Click()
Dim list As String
Dim folderlist As String
Dim folderarray() As String
'Dim i As Interger
For i = 0 To Me.selectedfolders.ListCount - 1
'folderlist = (Me.selectedfolders.Column(0, i))
'folderarray() = Join(Me.selectedfolders.Column(0, i), ",")
list = (Me.selectedfolders.Column(0, i))
folderarray() = Join(list, ",")
ReDim Preserve folderarray(i)
Next i
folderlist = folderarray
'folderarray() = Join(folderlist, ",")
MsgBox (folderlist)
End Sub
You can see the bits I have commented out, trying all sorts to get it to work. But I keep getting the message "Can't assign to array" at folderarray(i) = Join(list, ","). Any pointers as to where I am failing?
You can concatenate the list box items into a string, and then use Split() to load your array. That way, the array is sized automagically without you needing to ReDim.
I tested this code in Access 2010:
Dim folderarray() As String
Dim i As Long
Dim strList As String
For i = 0 To Me!selectedfolders.ListCount - 1
strList = strList & "," & Me!selectedfolders.Column(0, i)
Next
' use Mid() to exclude the first comma ...
folderarray = Split(Mid(strList, 2), ",")
Note I don't know what you want to do with the array after loading it. MsgBox folderarray would throw Type mismatch error. MsgBox Mid(strList, 2) would be valid, but if that's what you want, you wouldn't need the array.
1) declare the array. Take a look at https://msdn.microsoft.com/en-us/library/wak0wfyt.aspx
2) No need of support variable
3) Assign the values to your array with the correct syntax
Private Sub exportfolders_Click()
Dim folderarray() As String
Dim i As Interger
Redim folderarray (Me.selectedfolders.ListCount-1)
For i = 0 To Me.selectedfolders.ListCount - 1
folderarray(i) = Me.selectedfolders.Column(0, i)
Next i
' Write here what you want to do with your array
End Sub
You could try something like this:
Private Sub ListToArray()
Dim folderArray() As Variant
Dim currentValue As String
Dim currentIndex As Integer
Dim topIndex As Integer
topIndex = Me.selectedfolders.ListCount - 1
ReDim folderArray(0 To topIndex, 0 To 1)
For i = 0 To topIndex
currentValue = Me.selectedfolders.Column(0, i)
folderArray(i, 0) = i
folderArray(i, 1) = currentValue
Next i
End Sub
Note my example is a multi-dimensional array which will give you the ability to add more than one item should you chose to do so. In this example I added the value of "i" as a placeholder/ index.