PDA

View Full Version : Nested Collections



Imaginative1
08-07-2009, 04:22 PM
Version of the program - Excel 2003
What you want it to do - Created a nested Collection

Cell references, bookmark names, column letters, row numbers, worksheets, styles, whatever pertains to the information at hand
Error messages if any

If not the entire code, then at least some of it
Private Sub btnExecute_Click()

getPrevYearInfo
getCurrYearInfo

End Sub
Function getPrevYearInfo()

Dim listColumn As Range
Dim listColumnVolume As Integer

Set listColumn = Sheets("OASDI 2007").Range("B2").SpecialCells(xlCellTypeLastCell)
listColumnVolume = listColumn.Row

Dim cellContents
Dim rowIndex
Dim fo: fo = 0
Dim zips

For rowIndex = 1 To (listColumnVolume - 2)

cellContents = ActiveWorkbook.Sheets("OASDI 2007").Range("B2").Cells(rowIndex, 1).Value
v01 = ActiveWorkbook.Sheets("OASDI 2007").Range("B2").Cells(rowIndex, 2).Value

If Not IsNumeric(cellContents) Then

Dim fieldOfficeName
fieldOfficeName = cellContents

Dim fieldOfficeCollection As New Collection
fieldOfficeCollection.Add (fieldOfficeName)

Dim fieldOffice As New clsFieldOffice
fieldOffice.AddNameToFieldOfficeCollection (fieldOfficeName)
' fieldOffice.AccessFieldOfficeCollection

Dim fieldOfficeZipCodeCollection
Set fieldOfficeZipCodeCollection = New Collection

zips = 1
fo = fo + 1

Else

Dim fieldOfficeZipCode
fieldOfficeZipCode = cellContents

fieldOfficeZipCodeCollection.Add (fieldOfficeZipCode)

' If MsgBox(fieldOfficeCollection.item(fo) & " - " & fieldOfficeZipCodeCollection.item(zips) _
' & " - " & fieldOfficeZipCodeCollection.Count, vbOKCancel, "Title") = vbOK Then

' Else

' Exit Function

' End If

zips = zips + 1

End If

Next

Dim da: Set da = New DynamicArray

Dim fieldOffices
For fieldOffices = 1 To fieldOfficeCollection.Count

Dim fieldZips
For fieldZips = 1 To fieldOfficeZipCodeCollection.Count

If MsgBox(fieldOfficeCollection.item(fieldOffices) & " - " & _
fieldOfficeZipCodeCollection.item(fieldZips), vbOKCancel, "Title") = vbOK Then

Else

Exit Function

End If

Next

Next

End Function

Function getCurrYearInfo()

End Function

Sample data (before and after sample worksheets, add as attachments here)
Politeness and gratitude

Mark your thread solved, when it has been, by hitting the Thread Tools dropdown at the top of the thread.

I have a column that looks like this:

City A
12340 (Zip Code)
12341
12342
12343
12344

City B
22340 (Zip Code)
22341
22342
22343
22344

...etc...

I would like to make a collection of cities with a nested collection of constituent zip codes. How can I do with within a class module?

Oorang
08-13-2009, 10:35 PM
Hello Img,
Based on your declare/instantiate methodology I'm guessing your came from another language... C#?

Anyhow, the VBA.Collection object allows for you to place a collection as an item like this:
Sub Example()
Dim people As VBA.Collection
Set people = New Collection
Dim john As Collection
Set john = New Collection
john.Add 86537309, "Phone"
people.Add john
MsgBox people.Item(1).Item(1)
End Sub Personally I prefer to use code that is more self documenting, but as you alluded to, you will have to roll your own with classes. This is possible with VBA, but it does require a tiny (but well known) hack to get the enum working right.
First create a class module and name it "Person".
In Person put this code:
Option Explicit

Private m_ID As Long
Private m_Name As String

Public Property Get ID() As Long
ID = m_ID
End Property

Public Property Let ID(ByVal value As Long)
m_ID = value
End Property

Public Property Get Name() As String
Name = m_Name
End Property

Public Property Let Name(ByVal strName As String)
m_Name = strName
End Property Now for the slightly kludgy part. In VB6 you add/alter attributes via the VBE (Visual Basic Editor). However the VBE for VBA is less full featured, but the support is still there for attributes. So how to sneak them in? We turn to our good friend notepad. What I like to do is go ahead and build the class in VBE, and then document the hidden attributes in the remarks. Then export the class to a cls file. Now delete the class from the VBE and use notepad to add the attributes. Then re-import the file. Don't worry if that didn't make sense... It will:)
Ok, so for this example skip all that and just go straight to notepad and copy/paste this:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "People"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Warning, module makes use of VB Attributes.
'These attributes may be lost if you move, reformat, or cut this code.
'In the event of attribute loss, export module and use notepad to restore
'attributes as documented in each procedure.

Private m_Person As VBA.Collection

Private Sub Class_Initialize()
'This is your constructor.
Set m_Person = New VBA.Collection
End Sub

Public Sub Add(ByVal value As Person)
m_Person.Add value
End Sub

Public Sub Remove(ByVal index As Long)
m_Person.Remove index
End Sub

Public Sub Find(ByVal ID As Long)
Dim prsn As Person
For Each prsn In Me
'If Me.Item.ID = ID Then
' Stop
'End If
Next
End Sub

Public Sub Clear()
Set m_Person = Nothing
Set m_Person = New VBA.Collection
End Sub

Public Property Get Person(ByVal ID As Long) As Person
Attribute Person.VB_UserMemId = 0
'Uses: Attribute Person.VB_UserMemId = 0 (Makes Method the classes default.)
Dim prsn As Variant
For Each prsn In m_Person
If ID = prsn.ID Then
Set Person = prsn
Exit Property
End If
Next
End Property

Public Function All() As stdole.IUnknown
Attribute All.VB_UserMemId = -4
'Uses: Attribute All.VB_UserMemID = -4 (Makes function available to For Each.)
Set All = m_Person.[_NewEnum]
End Function
Save it as People.cls and the Import it into the VBE. This will not work unless you save it, then import it. Copy/paste will not work. It is normal for the lines containing the attributes to be invisible when imported. The only way to tell if you have lost the attributes is if the code breaks, or you export the class and check with notepad. Hence your final product should probably have the VBA project password protected to prevent accidental editing.

And now finally you are ready to run the example:
Sub Example2()
Dim employees As People
Set employees = New People
Dim john As Person
Dim jane As Person
Set john = New Person
john.ID = 9
john.Name = "John Q. Public"
employees.Add john
Set jane = New Person
jane.ID = 7
jane.Name = "Jane Doe"
employees.Add jane
MsgBox employees.Person(9).Name
Dim employee As Person
For Each employee In employees
MsgBox employee.ID
Next
End Sub

Paul_Hossler
08-14-2009, 04:04 PM
A technique that I've used seems to work that is a little different that doesn't seem to require the export/edit/import (maybe it should)

This is a class module


Option Explicit
Private cPersonName As String
Private cNumbers As Collection

Private Sub Class_Initialize()
cPersonName = Empty
Set cNumbers = New Collection
End Sub
Private Sub Class_Terminate()
cPersonName = Empty
Set cNumbers = Nothing
End Sub

Property Get PersonName() As String
PersonName = cPersonName
End Property
Property Let PersonName(s As String)
cPersonName = s
End Property

Property Get Numbers() As Collection
Set Numbers = cNumbers
End Property
Property Set Numbers(c As Collection)
Set cNumbers = c
End Property



and this is a regular module


Option Explicit

Sub Demo()
Dim People As Collection
Dim aPerson As clsPerson
Dim P As Variant, N As Variant

Set People = New Collection

Set aPerson = New clsPerson
With aPerson
.PersonName = "XLD"
Call .Numbers.Add(1111)
Call .Numbers.Add(2222)
Call .Numbers.Add(3333)
End With
Call People.Add(aPerson)
Set aPerson = Nothing

Set aPerson = New clsPerson
With aPerson
.PersonName = "Oorang"
Call .Numbers.Add(4444)
Call .Numbers.Add(5555)
Call .Numbers.Add(6666)
End With
Call People.Add(aPerson)
Set aPerson = Nothing

Set aPerson = New clsPerson
With aPerson
.PersonName = "macropod"
Call .Numbers.Add(7777)
Call .Numbers.Add(8888)
Call .Numbers.Add(9999)
End With
Call People.Add(aPerson)
Set aPerson = Nothing
Stop


For Each P In People
For Each N In P.Numbers
MsgBox P.PersonName & " -- " & N
Next
Next

Stop
End Sub


If there's any weaknesses in it, I'd really like to hear from the more experienced VBXers, but I really try to keep it simple as I can.

I know there's some stuff that is probably not required, and I never figured out a way to determine if when I Terminate an object that contains a collection, if I need to Remove the items from the collection (e.g. Numbers)


Paul

Oorang
08-14-2009, 08:24 PM
If there's any weaknesses in it, I'd really like to hear...
Not in my opinion. Mostly it's a style thing. Instead of iterating the object you are iterating the property. But functionally, nope. If someone on my team turned that in to avoid the import/export shenanigans, I'd accept it.
The only time I'd go for a more complete interface would be if it was going to be used as a library (for instance someone referring to it).

Paul_Hossler
08-15-2009, 08:23 AM
Mostly it's a style thing


Ah, programming is an Art, and not a Science

Question I still have is if it's necessary to iterate through the items added to the nested collection to release their memory when I terminate the class, or if just setting the collection itself to = Nothing is enougth.

I know (or at least I think I do) that when you .Add an item to the collection, Windows allocates some more memory, and that when you set that item to Nothing, Windows releases that memory.

So I figure that setting the collection variable = New Collection will make another instance of the Collection variable, and then .Add-ing more items will each allocate additional memory for each instance.

Setting the Collection itself to Nothing will release the memory for that instance of the Collection variable, BUT will it also release the memory that Windows allocated when the Items were added?

I suppose I could just to be safe, but then then higher level Collection (in the VBA module) has the same issue: Does setting the Collection = Nothing release the memory allocated to the .Add-ed items?


I don't know enough about the interaction of VBA and windows memory to even try to figure out a way to test.


Private Sub Class_Terminate()
cPersonName = Empty
'sufficient to release all .Add()-ed items?
Set cNumbers = Nothing
End Sub



I've gotten some 'Out of Memory' errors on some complicated WB, and I'm trying to be conscienous about my memory management. But I really like to use collections for a lot of structures since I like the flexibility they offer.


Paul

Bob Phillips
08-15-2009, 08:55 AM
If the garbage collection is working, setting to nothing will release the memory, all of it.

Paul_Hossler
08-15-2009, 09:08 AM
If the garbage collection is working, setting to nothing will release the memory, all of it.


Good to know.

Thanks

Paul

Oorang
08-15-2009, 10:40 AM
XLD is correct. VBA uses a "reference counting garbage collector". When you create a variable you create a reference to a spot in memory (+1). If you were to pass that variable byref another reference would be made (+1) when each variable falls out of scope (http://www.ozgrid.com/VBA/variable-scope-lifetime.htm) the counter is decremented (-1). When the counter hits zero the spot in memory is released for reuse. AFAIK the spot is not cleared so in some cases you may want to invoke the zeromemory api. But frankly, if the data is so sensitive you are worried about people viewing dead memory, you probably aren't using VBA anyway:)

adiadidas15
06-21-2010, 02:27 PM
Hello everyone,
As a follow up to Paul_Hossler's example, what if I wanted to sort the People collection by the first number listed in Numbers collection? When I try the following code (with different collection names) in VBA for Excel 2003, I get Run-time error '5': Invalid procedure call or argument.


For i = 1 to People.Count -1
For j = 2 to People.Count
If (People(i).Numbers(1) > People(j).Numbers(1)) Then
'Code to swap persons in People collection
End If
Next j
Next i


I think my Numbers collection index reference is confusing the compiler. If so, how can I fix it? Thanks!