Specific Class factory

[tiredofit]

The following code is taken from here:

https://www.youtube.com/watch?v=rZ96jR_y4gY

This is in Sheet1

Option Explicit

Sub CreateReport()
    Dim animals As New Collection
    Dim animal As Variant
    Dim choice As String
    Dim rng As Range
    Dim x As Integer
    Dim firstRow
    Dim lastRow As Integer

    ' Set parameters, no such thing as 'Fishs' so don't change that word
    If (Range("J5") = "Fish") Then
        choice = Range("J5")
    Else
        choice = Left(Range("J5"), Len(Range("J5")) - 1)
    End If
    
    firstRow = 4
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Use a loop and parse all of the animals into their respective classes
    For x = firstRow To lastRow
        Set rng = Range("A" & x & ":H" & x)
        Set animal = AnimalClassFactory(rng)
        animals.Add animal
    Next x
    
    PrintCollection animals, "animals"
    
    printReport animals, choice
End Sub

Sub PrintCollection(coll As Collection, name As String)

    Debug.Print vbNewLine & "Printing " & name & ":"

    On Error Resume Next
    Dim item As Variant
    
    For Each item In coll
        Debug.Print item.PrintOut()
    Next item
    
    On Error GoTo 0

End Sub

This is in a class called Animal:

' This is the Interface for the Cat and Dog classes.
' The Cat and Dog classes are required to implement
' these properties as they 'implement Animal'

Option Explicit

Public Property Get name() As String
End Property

Public Property Get Age() As Long
End Property

Public Property Get Weight() As Double
End Property

Public Property Get Talk() As String
End Property

This is in a class called Cat:

' Cat class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private likes_ As Variant
Private arrivalDate_ As Date
Private readyToHouse_ As Boolean
Private icon_ As Shape
Private meow_ As String ' unique to the Cat class

Private Sub Class_Initialize()
    legs_ = 4
    meow_ = "Meoww!"
   '  Set icon_ = Sheets("Icons").Shapes("catPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    arrivalDate_ = rng.Cells(1, 6)
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Private Sub Class_Terminate()
    ' Debug.Print "Cat class instance deleted, meow! (Goodbye)"
End Sub

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get Talk() As String
    Talk = meow_
End Property

Public Property Get Meow() As String
    Meow = "The cat says: " & meow_
End Property

Public Property Let Talk(ByVal Value As String)
    meow_ = Value
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

' Implement required interface properties
Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = Meow
End Property

What I don't understand is when the code reaches this point:

Sub PrintCollection(coll As Collection, name As String)

    Debug.Print vbNewLine & "Printing " & name & ":"

    On Error Resume Next
    Dim item As Variant
    
    For Each item In coll
        Debug.Print item.PrintOut() '******************************* 
    Next item
    
    On Error GoTo 0

End Sub

after the line with ************************** is executed, the code jumps to the appropriate class.

How does it know which class to go to?

 

[GWteB]

There is just ONE class, but there could be MULTIPLE instances of that class.
I say "could be", because the code you've provided does not compile. The Cat class doesn't have an AnimalClassFactory method. Of course it should be the Init method, but that would be a problem, because methods and properties of a custom class (unlike a Userform) can not be invoked from its default instance. In your code the Cat class isn't NEW'ed. Having that said, the Init method does not return an instance of itself, so it's not really a factory and the Set statement as in

     Set animal = AnimalClassFactory(rng)

' or what it should look like ..
     Set animal = Cat.Init(rng)

would fail on both examples. If it's changed like below it could work.

    Set Animal = New Cat
    Animal.Init rng
    animals.Add Animal

Now that other forum members reading this no longer have to wonder why they can't get the code to work, back to your question.

... the code jumps to the appropriate class. How does it know which class to go to?

Each instance of the Cat class is stored into a collection; not the instance itself, but a pointer to that instance. Since that collection is iterated with the For Each construct using the item variable, in each loop the item variable points to a different instance of the Cat class. In each loop the Printout method of the current instance is invoked. If there's just one instance of the Cat class, then only the properties of that one class are displayed in the imidiate window.

 

[tiredofit]

There is just ONE class, but there could be MULTIPLE instances of that class.
I say "could be", because the code you've provided does not compile. The Cat class doesn't have an AnimalClassFactory method. Of course it should be the Init method, but that would be a problem, beacause methods and properties of a custom class (unlike a Userform) can not be invoked from its default instance. In your code the Cat class isn't NEW'ed. Having that said, the Init method does not return an instance of itself, so it's not really a factory and the Set statement as in

     Set animal = AnimalClassFactory(rng)

' or what it should look like ..
     Set animal = Cat.Init(rng)

would fail on both examples. If it's changed like below it could work.

    Set Animal = New Cat
    Animal.Init rng
    animals.Add Animal

Now that other forum members reading this no longer have to wonder why they can't get the code to work, back to your question.



Each instance of the Cat class is stored into a collection; not the instance itself, but a pointer to that instance. Since that collection is iterated with the For Each construct using the item variable, in each loop the item variable points to a different instance of the Cat class. In each loop the Printout method of the current instance is invoked. If there's just one instance of the Cat class, then only the properties of that one class are displayed in the

Apologies, I only posted what I thought was relevant.

For the benefit of other readers, I'll update it tomorrow.

 

[GWteB]

For the benefit of other readers, I'll update it tomorrow.

OK.

Has your question been answered satisfactorily?

 

[tiredofit]

OK.

Has your question been answered satisfactorily?

Thanks for responding, though I'm not sure if I fully understand.

This is all the code. Is it now a class factory?

This is in Sheet1:

Option Explicit

Sub CreateReport()
    Dim animals As New Collection
    Dim animal As Variant
    Dim choice As String
    Dim rng As Range
    Dim x As Integer
    Dim firstRow
    Dim lastRow As Integer

    ' Set parameters, no such thing as 'Fishs' so don't change that word
    If (Range("J5") = "Fish") Then
        choice = Range("J5")
    Else
        choice = Left(Range("J5"), Len(Range("J5")) - 1)
    End If
    
    firstRow = 4
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Use a loop and parse all of the animals into their respective classes
    For x = firstRow To lastRow
        Set rng = Range("A" & x & ":H" & x)
        Set animal = AnimalClassFactory(rng)
        animals.Add animal
    Next x
    
    PrintCollection animals, "animals"
    
    printReport animals, choice
End Sub

' Outputs the report to the Report Card
Sub printReport(animals As Collection, choice As String)

Dim aCount As Integer
Dim aWeight As Double
Dim aAvgWeight As Double
Dim aAge As Integer
Dim aAvgAge As Integer
Dim aStayTime As Integer
Dim aMaxStayTime As Integer
Dim aBreeds() As String
Dim aAvgStayTime As Integer
Dim aReadyToHouse As Integer
Dim animal As Variant
    
    ' obtain all of the stats from the animals objects
    For Each animal In animals
        If TypeName(animal) = choice Then
            aCount = aCount + 1
            aWeight = aWeight + animal.Weight
            aAvgWeight = aWeight / aCount
            aAge = aAge + animal.Age
            aAvgAge = aAge / aCount
            aStayTime = aStayTime + animal.daysHoused
            If (animal.daysHoused > aMaxStayTime) Then aMaxStayTime = aStayTime
            aAvgStayTime = aStayTime / aCount
            ReDim Preserve aBreeds(aCount - 1)      ' Increase the items in an array
            aBreeds(aCount - 1) = animal.Breed
            If animal.readyToHouse = True Then aReadyToHouse = aReadyToHouse + 1
        End If
    Next animal
        
    Dim reportStart As Range
    Set reportStart = Range("L4")
    If (choice = "Fish") Then
        reportStart.Offset(-1, 0) = "About Our " & choice
    Else
        reportStart.Offset(-1, 0) = "About Our " & choice & "s"
    End If
    reportStart = "We have " & aCount & " " & LCase(choice) & "s"
    reportStart.Offset(1, 0) = "Their total weight is " & aWeight & " kg"
    reportStart.Offset(2, 0) = "The average age of the " & LCase(choice) & "s" & " is " & aAvgAge & " in " & LCase(choice) & " years"
    reportStart.Offset(3, 0) = "The average length of stay to date is " & aAvgStayTime & " days"
    reportStart.Offset(4, 0) = "We have the following breeds: " & Join((aBreeds), ",")
    reportStart.Offset(5, 0) = aReadyToHouse & " are ready to house"
    reportStart.Offset(6, 0) = "Our longest " & LCase(choice) & "s stay is " & aMaxStayTime & " days"

' Copy and paste from the Icons sheet
ActiveSheet.Shapes(3).Delete        ' delete the initial icon
DoEvents

Sheets("Icons").Shapes(LCase(choice) & "Pic").Copy
With ActiveSheet
   .Select
   .Range("P3").Select
   .Paste
   ' Shapes(LCase(choice) & "Pic").Top = Shapes(LCase(choice) & "Pic").Top - 10    ' bump up
End With
Range("A1").Select
     
' Change the picture of the pet and ANIMATE it (to be covered in another tutorial!)
' Animate the picture
Dim rep_count As Integer
rep_count = 0

Do
    DoEvents
    rep_count = rep_count + 1
    Shapes(LCase(choice) & "Pic").Left = rep_count * 3 + 1000
    timeout (0.01)
    ActiveWindow.SmallScroll down:=1        ' these two lines ensurance animation on Mac
    ActiveWindow.SmallScroll up:=1
Loop Until rep_count = 20
End Sub

Sub timeout(duration_ms As Double)
Dim startTime As Variant

    startTime = Timer
    Do
    DoEvents
    Loop Until (Timer - startTime) >= duration_ms
End Sub
' Checks the type of animal and returns into a class
Function AnimalClassFactory(rng As Range) As Variant

Dim animalType As String

animalType = rng.Cells(1, 2)

Dim animal As Variant
Select Case animalType
    Case "Cat":
        Set animal = New cat
    Case "Dog":
        Set animal = New dog
    Case "Hamster":
        Set animal = New Hamster
    Case "Fish":
        Set animal = New Fish
        ' Set animal = New hamster
End Select

animal.Init rng

' animal is returned to be added to the main collection
Set AnimalClassFactory = animal

End Function

Sub PrintCollection(coll As Collection, name As String)

    Debug.Print vbNewLine & "Printing " & name & ":"

    On Error Resume Next
    Dim item As Variant
    
    For Each item In coll
        Debug.Print item.PrintOut()
    Next item
    
    On Error GoTo 0

End Sub

Class Animal:

' This is the Interface for the Cat and Dog classes.
' The Cat and Dog classes are required to implement
' these properties as they 'implement Animal'

Option Explicit

Public Property Get name() As String
End Property

Public Property Get Age() As Long
End Property

Public Property Get Weight() As Double
End Property

Public Property Get Talk() As String
End Property

Class Cat:

' Cat class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private likes_ As Variant
Private arrivalDate_ As Date
Private readyToHouse_ As Boolean
Private icon_ As Shape
Private meow_ As String ' unique to the Cat class

Private Sub Class_Initialize()
    legs_ = 4
    meow_ = "Meoww!"
   '  Set icon_ = Sheets("Icons").Shapes("catPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    arrivalDate_ = rng.Cells(1, 6)
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Private Sub Class_Terminate()
    ' Debug.Print "Cat class instance deleted, meow! (Goodbye)"
End Sub

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get Talk() As String
    Talk = meow_
End Property

Public Property Get Meow() As String
    Meow = "The cat says: " & meow_
End Property

Public Property Let Talk(ByVal Value As String)
    meow_ = Value
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

' Implement required interface properties
Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = Meow
End Property

Class Dog

' Dog class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private arrivalDate_ As Date
Private likes_ As Variant
Private icon_ As Shape
Private bark_ As String ' unique to the Dog class
Private readyToHouse_ As Boolean

Private Sub Class_Initialize()
    legs_ = 4
    bark_ = "Woof!"
    ' Set icon_ = Sheets("Icons").Shapes("fishPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    arrivalDate_ = rng.Cells(1, 6)
        likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Private Sub Class_Terminate()
    ' Debug.Print "Dog class instance deleted, woof! (Goodbye)"
End Sub

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get Bark() As String
    Bark = "The dog says: " & bark_
End Property

Public Property Get Talk() As String
    Talk = bark_
End Property

Public Property Let Talk(ByVal Value As String)
    bark_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = Bark
End Property

Class Fish:

' Fish class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private likes_ As Variant
Private arrivalDate_ As Date
Private readyToHouse_ As Boolean
Private icon_ As Shape

Private Sub Class_Initialize()
    legs_ = 4
    Set icon_ = Sheets("Icons").Shapes("fishPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    arrivalDate_ = rng.Cells(1, 6)
    likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get Talk() As String
    Talk = ""
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

' Implement required interface properties
Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = ""
End Property

Class Hamster:

' Hamster class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private likes_ As Variant
Private arrivalDate_ As Date
Private readyToHouse_ As Boolean
Private icon_ As Shape

Private Sub Class_Initialize()
    legs_ = 4
    Set icon_ = Sheets("Icons").Shapes("hamsterPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    arrivalDate_ = rng.Cells(1, 6)
        likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property


Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get Talk() As String
    Talk = ""
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

' Implement required interface properties
Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = ""
End Property

The data:

 

[RoryA]

You have a collection containing objects. If you loop through that and call a method of each object, it will naturally jump to the code for the relevant class for that obejct.

 

[GWteB]

This is all the code. Is it now a class factory?

If the class instantiates itself, it is called a factory. This one doesn't, so in a strict sense it's not a factory. Incidentally, this is not possible without additional interventions. Each code module has some invisible attributes. These are visible when you export the module and open it in a text editor. In this case it concerns the PredeclaredID attribute. If you export a regular class module and then a userform you will see that the attribute on the class equals False, and on the userform equals True. This attribute determines whether you can use the default instance of a class without NEW'ing (like a Userform) or not.

 

[tiredofit]

You have a collection containing objects. If you loop through that and call a method of each object, it will naturally jump to the code for the relevant class for that obejct.

Thanks, I should've spotted that!

If the class instantiates itself, it is called a factory. This one doesn't, so in a strict sense it's not a factory. Incidentally, this is not possible without additional interventions. Each code module has some invisible attributes. These are visible when you export the module and open it in a text editor. In this case it concerns the PredeclaredID attribute. If you export a regular class module and then a userform you will see that the attribute on the class equals False, and on the userform equals True. This attribute determines whether you can use the default instance of a class without NEW'ing (like a Userform) or not.

Thanks for your detailed explanation.

 

[GWteB]

You are welcome.

 

[Kyle123]

I disagree, this is a factory. An object doesn't need to instantiate itself to be a factory, in fact it can't instantiate itself, you can only instantiate an object from the outside.

A factory is simply a method that abstracts the logic of the creation of an object, allowing the calling code to refer to a common interface.

If we take out the salient parts of the code, we end up with this:
IAnimal Class

Option Explicit

Public Property Let Name(ByVal RHS As String): End Property
Public Property Get Name() As String: End Property
Public Sub MakeSound(): End Sub

Cat Class

Implements IAnimal

Private name_ As String

Private Sub IAnimal_MakeSound()
    Debug.Print "Meow"
End Sub

Private Property Get IAnimal_Name() As String
    IAnimal_Name = name_
End Property

Private Property Let IAnimal_Name(ByVal RHS As String)
    name_ = RHS
End Property

Dog Class

Implements IAnimal

Private name_ As String

Private Sub IAnimal_MakeSound()
    Debug.Print "Woof"
End Sub

Private Property Get IAnimal_Name() As String
    IAnimal_Name = name_
End Property

Private Property Let IAnimal_Name(ByVal RHS As String)
    name_ = RHS
End Property

Calling code

Sub test()

    Dim Dog As IAnimal
    Dim Cat As IAnimal
    
    Set Dog = CreateAnimal("dog")
    Set Cat = CreateAnimal("cat")
    
    
    Dog.MakeSound
    Cat.MakeSound

End Sub

'Factory Function
Public Function CreateAnimal(ByVal animalType As String) As IAnimal
    Select Case UCase(animalType)
        Case "CAT": Set CreateAnimal = New Cat
        Case "DOG": Set CreateAnimal = New Dog
    End Select
End Function

The only part of your original code that should really be improved to really stick to the point of a factory is

Function AnimalClassFactory(rng As Range) As Variant

Should really be:

Function AnimalClassFactory(rng As Range) As Animal

This is pretty much a textbook class factory. You could make it a bit more explicit by creating a fake singleton using a module (I tend to do this for config and settings etc), by moving the CreateAnimal function to a Module called AnimalFactory, you'd then have:

    Set Dog = AnimalFactory.CreateAnimal("dog")
    Set Cat = AnimalFactory.CreateAnimal("cat")