Working with Class Modules, Custom Object and Collections

voudouJoe

New Member
Joined
Aug 27, 2007
Messages
1
Giving back

After a great deal of head-banging and coming up empty on the internet, I figured out how to work with Class Modules, Custom Objects, Collections and Dictionary Objects in Class Modules. I put this here in hopes that someone who needs it will will find it.

To use the example, create 3 class modules: Parent, Kid and Pet
I did this in Word, but Excel will probably work as well. If in Excel, you will need to create a word application object -- something like
Set appWord = new object (Word.application) to use the dictionary object. You'll also need to create a reference to the Word object model in Tools/References

Paste the class module code in to the respective class module and the standard module code into a standard module.
I did not declare all variables nor did I spend anytime on error handling.

Rgds - voudouJoe

'-------------------------
Class Module Named: Parent
'-------------------------

'Each Parent has a name
Private p_Name As String

'Gives Parent object a collection named Kids
'stored in a private p_colKids variable
Private p_colKids As Collection

'Kid is a user defined object defined in another class module
'The Kid object must be Dim'd in the standard module (see example below)
Private Sub Class_Initialize()
Set Me.Kids = New Kid
End Sub

Public Property Let Name(strName As String)
p_Name = strName
End Property
Public Property Get Name() As String
Name = p_strName
End Property

'Kid is a user defined object in another class module
Public Property Set Kids(newKid As Kid)
If p_colKids Is Nothing Then Set p_colKids = New Collection
End Property
Public Property Get Kids() As Collection
Set Kids = p_colKids
End Property

'This is a custom Parent-related sub to replace one kid object with another
Public Sub ReplaceKid(newKid As Kid, idx As Integer)
Set tmp = p_colKids
tmp.Remove idx
tmp.Add newKid, Key:=newKid.Name, Before:=idx
End Sub

'------------------------------------------------------------------------
'Class Module Named: Kid
'Note this noun is singular where the collection object (above) is plural
'------------------------------------------------------------------------

Private p_Name As Variant
Private p_Age As Variant
Private p_Friends As Variant
Private p_FavoriteFoods As Collection
Private p_colPets As Collection
Private p_dicTeachers As Object

'Kid has a number of attributes that this example manages in 3 different ways
'Favorite Foods is a collection of items that are NOT objects
'Pets is a collection of Pet objects (where the Pet is defined in another class module)
'Teachers is a dictonary object where there is a unique Key and an associated value
'Each of these must be initialized
Private Sub Class_Initialize()
Set Me.FavoriteFoods = New Collection
Set Me.Pets = New Pet
Set Me.Teachers = CreateObject("Scripting.Dictionary")
End Sub

'Name and Age are simple properties directly defined
Public Property Let Name(strName As String)
p_Name = strName
End Property
Public Property Get Name() As String
Name = p_Name
End Property
Public Property Let Age(iAge)
p_Age = iAge
End Property
Public Property Get Age() As Variant
Age = p_Age
End Property

'Friends are a number of Friends that are passed an an array of values e.g., ayFriends = array("joe", "sam")
Public Property Let Friends(ayFriends As Variant)
p_Friends = ayFriends
End Property
Public Property Get Friends() As Variant
Friends = p_Friends
End Property

'Favorite foods is a simple collection of items
Public Property Set FavoriteFoods(x As Collection)
If p_FavoriteFoods Is Nothing Then Set p_FavoriteFoods = New Collection
End Property
Public Property Get FavoriteFoods() As Collection
Set FavoriteFoods = p_FavoriteFoods
End Property

'Pets is a collection of associated user defined objects (that are defined in another class module)
'This shoes that a Parent can have a colleciton of Kid objects where each Kid has a collection of Pet objects
'This nesting can go on and on, I suppose
Public Property Set Pets(newPet As Pet)
If p_colPets Is Nothing Then Set p_colPets = New Collection
End Property
Public Property Get Pets() As Collection
Set Pets = p_colPets
End Property

'Teachers is a directory object associated with each Kid object where there is a unique key (the teacher's 'subject' in this example)
'and an associated value (the teacher's name in this example)
Public Property Set Teachers(objDic As Object)
If p_dicTeachers Is Nothing Then Set p_dicTeachers = objDic
End Property
Public Property Get Teachers() As Object
Set Teachers = p_dicTeachers
End Property

'This is a function to create a Kid and load many attributes with one line of VBA code
'The only required value is NAME. You can do optional values in a Sub or Function
'Optional values cannot be used in a Property Let statement
'Use IsMissing to determine wether or not to try and set the associated property
Public Function Make(strName As String, Optional iAge As Variant, Optional ayFriends As Variant, Optional vFavoriteFoods As Variant) As Kid
'use a temporary object to create a new Kid object and store values
Set makekid = New Kid
With makekid
.Name = strName
If Not IsMissing(iAge) Then .Age = iAge
If Not IsMissing(ayFriends) Then .Friends = ayFriends
'use IsArray to determine if there is 1 Favorite Food String or an array of strings
'because FavoriteFoods is a collection (unlike Friends which is an array)
'items must be added 1 element at a time
If Not IsMissing(vFavoriteFoods) Then
If IsArray(vFavoriteFoods) Then
For Each i In vFavoriteFoods
.FavoriteFoods.Add i
Next i
Else
.FavoriteFoods.Add vFavoriteFoods
End If
End If
End With
'set the results of the Make function to the temporary object
Set Make = makekid
End Function

'use this function to return 1 friend from the collection
Public Function GetFriend(idx As Integer) As String
If Not IsMissing(idx) Then
GetFriend = p_Friends(idx)
Else
GetFriend = p_Friends
End If
End Function

'------------------------------------------------------------------------------
'Class Module Named: Pet
'Note this noun is singular where the collection object (above= Pets) is plural
'------------------------------------------------------------------------------

'create a simple Pet object to nest under a Kid object under a Parent object

Private p_PetType As String
Private p_Name As String

Public Property Let PetType(strPetType As String)
p_PetType = strPetType
End Property
Public Property Get PetType() As String
PetType = p_PetType
End Property

Public Property Let Name(strName As String)
p_Name = strName
End Property
Public Property Get Name() As String
Name = p_Name
End Property

'------------------------------------------------------------------------------
'Standard Module Named: whatever you want
'------------------------------------------------------------------------------

Sub DEV004()
'you must Dim a parent custom object
Dim p As New parent
'a Kid object must be declared; also created a New Kid for examples below
Dim tmp As Kid, newKid As New Kid

p.Name = "Judy"

'ADD A NEW KID; SET EQUAL TO AN OBJECT VARIABLE
'Aattributes to the Kid object using the object variable
p.Kids.Add New Kid
Set Tom = p.Kids(p.Kids.Count)
Tom.Name = "Tommy"

'use the Make function in the Kid class module to create a new kid object and load many attributes at once
Set tmp = newKid.Make("Danielle", 7, Array("Rebecca", "Samantha"), "Tacos")
'you may use the tmp variable to add additional attributes
tmp.Teachers.Add "English", "Ms. Davis"

'add the Kid object to the Parent Kids collection
'use tmp and tmp.name (the key) so you can refer to the kid by name
p.Kids.Add tmp, tmp.Name
'add more attributes to the kid by referring to the kid by name rather than index (also an option)
With p.Kids("Danielle").Teachers
.Add "Reading", "Ms. Erickson"
.Add "Math", "Ms. Bullock"
End With

'create a pet object and associate with a Kid object in the Parent.Kids collection
Dim iPet As New Pet
iPet.PetType = "cat": iPet.Name = "Fluffy"
p.Kids("Danielle").Pets.Add iPet, iPet.Name

'print some attributes
Debug.Print p.Kids(1).Name
With p.Kids("Danielle")
Debug.Print .Age
Debug.Print .Pets(1).Name
'add a new pet and include the key value
.Pets.Add New Pet, "Whiskers"
' the key value does NOT set the name value of the Pet object, this must be done separately
.Pets("Whiskers").Name = "Whiskers"
.Pets("Whiskers").PetType = "Rabbit"
End With

'make another kid object and associate with the parent collection
'this kid object has multiple FavoriteFood items to add to the FavoriteFoods collection
Set tmp = newKid.Make("Rieley", 6, Array("Matthew", "Andrew"), Array("Pickles", "Pizza"))
p.Kids.Add tmp, tmp.Name

'print all this kid's favorite foods
For Each i In p.Kids("Rieley").FavoriteFoods
Debug.Print i
Next i

'print ONE of the friend names
Debug.Print p.Kids("Rieley").GetFriend(1)
'get the array of friends, print one
ayFriends = p.Kids(2).Friends
Debug.Print ayFriends(0)

'make another Kid object
'replace the original Kid #1 with this new kid using the custom funciton in the Parent class module
Set tmp = newKid.Make("Logan", 12, Array("Cody", "Zack"))
p.ReplaceKid tmp, 1

'print all the kids names in the Parent's Kids collection
For Each iKid In p.Kids
Debug.Print iKid.Name
Next iKid

Stop
'stop and take a look at the way objects are sotred in the Locals window in the VBA editor

End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
This is exactly what I was looking for, except it doesn't include how to it works with Interfaces. For example in using your Parent,Kid,Pet example if I wanted to put these classes behind interfaces, i get an Object/Method not set error when trying to add objects to the collection objects. Is there a way to do this same example with interfaces? Thanks in advance to any reply that may be received.
 
Upvote 0
Thank you very much; I found this extremely helpful.
It has been nearly five years since you posted this and I just found it.

I see that nobody ever thanked you. Better late than never I suppose.
 
Upvote 0

Forum statistics

Threads
1,215,424
Messages
6,124,817
Members
449,190
Latest member
rscraig11

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top