When writing OOP code in VBA, it’s important to keep a number of things in mind:

• A class can be given a default instance, which makes all its public members usable without needing to create a new instance.
• An interface can very well expose only public property get accessors, but no mutator.
• A class Implements as many interfaces as needed.
• Events cannot be exposed by an interface.

VB_Attributes

If you ever exported a class module and examined it in your favorite text editor, you probably noticed these:

Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

The VB_Name attribute determines the identifier the class will be referred to in code; VB_GlobalNameSpace makes its members global which is kinda anti-OOP.. VB_Creatable can only be False in VBA projects, and means that other VBA projects cannot directly create a new instance of that class. VB_Exposed determines whether other VBA projects can see this class or not.

The one we’re interested in, is VB_PredeclaredId. If you export a UserForm module, you’ll notice it’s predeclaredId attribute is  True. This is what allows you to work against a form without creating an instance – you’re using the default instance when you do that.. and you shouldn’t.

Normally.

 

Finding the cheapest hotel

Here’s a little problem that I’m going to solve in VBA, with full-blown OOP:

A hotel chain operating in Goa wishes to offer room reservation services. They have three hotels in Goa: GreenValley, RedRiver and BlueHills. Each hotel has separate weekday and weekend (Saturday and Sunday) rates. There are special rates for rewards customer as a part of loyalty program.Each hotel has a rating assigned to it.

• GreenValley with a rating of 3 has weekday rates as Rs1100 for regular customer and Rs800 for rewards customer. The weekend rates are 900 for regular customer and 800 for a rewards customer.
• RedRiver with a rating of 4 has weekday rates as Rs1600 for regular customer and Rs1100 for rewards customer. The weekend rates are 600 for regular customer and 500 for a rewards customer.
• BlueHills with a rating of 5 has weekday rates as Rs2200 for regular customer and Rs1000 for rewards customer. The weekend rates are 1500 for regular customer and 400 for a rewards customer.

IMPORTANT: Before you read any further

This exercise isn’t about solving the problem. The problem is rather easy to solve. It’s about managing changes, writing code that can survive changes. Specifications are never carved in stone, they change all the time. Today the hotel chain has 3 hotels, tomorrow they might have 3,500. Today the hotel chain has two types of customers. Tomorrow they might have three; eventually the chain acquires another chain in another country, and then the prices need to be converted between USD and EUR before they can be compared. The foreign hotels might have different statutory holidays, and it wouldn’t matter until the CEO decided that July 4th reservations would be 25% off, but only in the US hotels.

This solution isn’t the one OOP way to do things. It’s a solution; your mileage may vary. There are many, many ways to do this – but a monolithic block of procedural code wouldn’t survive very long with the hectic reality depicted above, would it? Or it would, but then bugs would start appearing, and more changes would have to be made, perhaps introducing new bugs, too. Sounds familiar? Keep reading.

Okay. Ready?

So, let’s say I want to store information about some pricing rule, based on some DateType and some CustomerType. I could describe this type as follows (the enums don’t belong to the interface, they’re just public types that were convenient to define there):

Option Explicit

Public Enum CustomerType
    Regular
    Premium
End Enum

Public Enum DateType
    WkDay
    WkEnd
End Enum

Public Property Get DateType() As DateType
End Property

Public Property Get CustomerType() As CustomerType
End Property

Public Function ToString() As String
End Function

Let’s call this interface IPricingRuleInfo.

In well-designed OOP, one doesn’t design an interface to change. This IPricingRuleInfo interface will change, as soon as the requirements change and we need to expose a new property. But we’re going to use VBA interfaces differently here… just bear with me.

What we’re going to do with this interface, is a façade that the program will be written against, while we hide the implementation details.

The implementation would look like this:

Option Explicit

Private Type TInfo
    DateType As DateType
    CustomerType As CustomerType
End Type
Private this As TInfo

Implements IPricingRuleInfo

Public Property Get CustomerType() As CustomerType
    CustomerType = this.CustomerType
End Property

Public Property Let CustomerType(ByVal value As CustomerType)
    this.CustomerType = value
End Property

Public Property Get DateType() As DateType
    DateType = this.DateType
End Property

Public Property Let DateType(ByVal value As DateType)
    this.DateType = value
End Property

Public Property Get Self() As IPricingRuleInfo
    Set Self = Me
End Property

Public Function Create(ByVal dtType As DateType, ByVal custType As CustomerType) As IPricingRuleInfo
    With New PricingRuleInfo
        .DateType = dtType
        .CustomerType = custType
        Set Create = .Self
    End With
End Function

Private Property Get IPricingRuleInfo_CustomerType() As CustomerType
    IPricingRuleInfo_CustomerType = this.CustomerType
End Property

Private Property Get IPricingRuleInfo_DateType() As DateType
    IPricingRuleInfo_DateType = this.DateType
End Property

Private Function IPricingRuleInfo_ToString() As String
    IPricingRuleInfo_ToString = CStr(this.CustomerType) & ";" & CStr(this.DateType)
End Function

Notice this Create method: that’s the Factory Method, intended to be used from the default instance. The properties are instance members that really belong to an instance of the class; the implementation also exposes Property Let accessors, so that Create can assign the proprerty values of the instance to create and return.

The Self getter is a little trick that enables this neat With New syntax.

The private type helps remove awkward prefixes by legalizing identical field and property names, and if the class’ state ever needs to be serialized, it’s child play.

Any code that works with a PricingRuleInfo instance will have access to its setters and default instance. But the client code wouldn’t do that: the client code works with the IPricingRuleInfo interface, and know nothing of a default instance, a factory method, or Property Let members: it only sees CustomerType and DateType read-only values, and a ToString method that concatenates them into a string.

And now we can have an IPricingRule interface like this:

Option Explicit

Public Property Get RuleInfo() As IPricingRuleInfo
End Property

Public Function Evaluate(ByVal info As IPricingRuleInfo) As Currency
End Function

And then we can have as many implementations as we like – here, a simple one called FixedAmountPricingRule, that takes an amount at creation, encapsulates it, and then uses it to return a fixed amount when evaluating the rule:

Option Explicit

Private Type TRule
    RuleInfo As IPricingRuleInfo
    Amount As Currency
End Type
Private this As TRule

Implements IPricingRule

Private Property Get IPricingRule_RuleInfo() As IPricingRuleInfo
    Set IPricingRule_RuleInfo = this.RuleInfo
End Property

Private Function IPricingRule_Evaluate(ByVal info As IPricingRuleInfo) As Currency
    IPricingRule_Evaluate = this.Amount
End Function

Public Property Get RuleInfo() As IPricingRuleInfo
    Set RuleInfo = this.RuleInfo
End Property

Public Property Set RuleInfo(ByVal value As IPricingRuleInfo)
    Set this.RuleInfo = value
End Property

Public Property Get Amount() As Currency
    Amount = this.Amount
End Property

Public Property Let Amount(ByVal value As Currency)
    this.Amount = value
End Property

Public Property Get Self() As IPricingRule
    Set Self = Me
End Property

Public Function Create(ByVal info As IPricingRuleInfo, ByVal value As Currency) As IPricingRule
    With New FixedAmountPricingRule
        Set .RuleInfo = info
        .Amount = value
        Set Create = .Self
    End With
End Function

Again, we give this class a default instance by setting its VB_PredeclaredId attribute to True and re-importing the module into the project.

Next we’ll need an abstraction for hotels – enter IHotel:

Option Explicit

Public Property Get Name() As String
End Property

Public Property Get Rating() As Byte
End Property

Public Function CalculatePricing(ByVal info As IPricingRuleInfo) As Currency
End Function

Public Function GetDateType(ByVal value As Date) As DateType
End Function

Notice how the interface exposes nothing of IPricingRule. The implementation has a dependency on IPricingRule and IPricingRuleInfo, but knows nothing of the concrete types. Here’s the code:

Option Explicit

Private Type THotel
    PricingRules As New Scripting.Dictionary
    Name As String
    Rating As Byte
End Type
Private this As THotel
Implements IHotel

Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Name(ByVal value As String)
    this.Name = value
End Property

Public Property Get Rating() As Byte
    Rating = this.Rating
End Property

Public Property Let Rating(ByVal value As Byte)
    this.Rating = value
End Property

Public Property Get Self() As IHotel
    Set Self = Me
End Property

Public Function Create(ByVal hotelName As String, ByVal stars As Byte, Optional ByVal rules As Collection = Nothing) As StandardHotel
 
    Dim rule As IPricingRule
    With New StandardHotel
 
        .Name = hotelName
        .Rating = stars
 
        If Not rules Is Nothing Then
            For Each rule In rules
                .AddPricingRule rule
            Next
        End If
 
        Set Create = .Self
 
    End With

End Function

Public Sub AddPricingRule(ByVal rule As IPricingRule)
    this.PricingRules.Add rule.RuleInfo.ToString, rule
End Sub

Private Function IHotel_CalculatePricing(ByVal info As IPricingRuleInfo) As Currency
    Dim rule As IPricingRule
    Set rule = this.PricingRules(info.ToString)
    IHotel_CalculatePricing = rule.Evaluate(info)
End Function

Private Function IHotel_GetDateType(ByVal value As Date) As DateType
    IHotel_GetDateType = IIf(Weekday(value, vbMonday) <= 5, WkDay, WkEnd)
End Function

Private Property Get IHotel_Name() As String
    IHotel_Name = this.Name
End Property

Private Property Get IHotel_Rating() As Byte
    IHotel_Rating = this.Rating
End Property

Notice the GetDateType function: it allows a given IHotel implementation to come up with funky creative ways to determine the DateType for a given date value.

Also interesting, the AddPricingRule procedure, which isn’t exposed by the IHotel interface, but that adds pricing rules to the encapsulated dictionary of pricing rules; given an IPricingRuleInfo instance, we can now calculate the price by evaluating the rule.

The HotelFinder class is just an object that encapsulates the logic to find the cheapest hotel, given two dates and a CustomerType:

Option Explicit

Private Type TFinder
    Hotels As Collection
End Type
Private this As TFinder

Public Property Get Hotels() As Collection
    Set Hotels = this.Hotels
End Property

Public Function FindCheapestHotel(ByVal fromDate As Date, ByVal toDate As Date, ByVal custType As CustomerType) As String

    Dim place As IHotel
    Dim checkedDate As Date

    Dim cheapestAmount As Currency
    Dim cheapestHotel As IHotel
 
    Dim hotelTotal As Currency
    For Each place In this.Hotels
 
        hotelTotal = 0
        For checkedDate = fromDate To toDate
            Dim info As IPricingRuleInfo
            Set info = PricingRuleInfo.Create(place.GetDateType(checkedDate), custType)
            hotelTotal = hotelTotal + place.CalculatePricing(info)
        Next
 
        If cheapestAmount = 0 Or hotelTotal < cheapestAmount Then
            cheapestAmount = hotelTotal
            Set cheapestHotel = place
        ElseIf hotelTotal = cheapestAmount And cheapestHotel.Rating > place.Rating Then
            'same price, but higher rating; higher rating gets precedence
            Set cheapestHotel = place
        End If
 
        Debug.Print place.Name, Format(hotelTotal, "$#,##0.00")
    Next
 
    FindCheapestHotel = cheapestHotel.Name

End Function

Private Sub Class_Initialize()
    Set this.Hotels = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Hotels = Nothing
End Sub

So, we iterate a collection of hotels, evaluate the stay at each one (output the amount to the debug pane), and return the name of the cheapest hotel.

At the top of the call stack lies a procedure that creates an instance of that HotelFinder, populates its Hotels collection, and ouputs the result of the FindCheapestHotel function. This is where we reap the benefits of OOP: initializing the hotels reads pretty much exactly like reading the specs.

Option Explicit

Public Sub Test(ByVal checkin As Date, ByVal checkout As Date, ByVal custType As CustomerType)
    Dim finder As New HotelFinder
    InitializeHotels finder
    Debug.Print finder.FindCheapestHotel(checkin, checkout, custType)
End Sub

Private Sub InitializeHotels(ByVal finder As HotelFinder)

    With StandardHotel.Create("Green Valley", 3)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 800)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Premium), 800)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Regular), 1100)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Regular), 900)
        finder.Hotels.Add .Self
    End With
 
    With StandardHotel.Create("Red River", 4)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 1100)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Premium), 500)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Regular), 1600)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Regular), 600)
        finder.Hotels.Add .Self
    End With
 
    With StandardHotel.Create("Blue Hills", 5)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 1000)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Premium), 400)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Regular), 2200)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Regular), 1500)
        finder.Hotels.Add .Self
    End With
 
End Sub

And we get output:

Test Now, Now + 3, Premium
Green Valley $3,200.00
Red River $4,400.00
Blue Hills $4,000.00
Green Valley

Is that over-engineered? As I said above, most definitely. But then, how would a Java, C#, or VB.NET solution look like? Not much different, save a PricingStrategyFactoryFactory class for the Java code of course! The point, again, was an exercise in writing code resistant to change, not just solving a problem. Now when the specs change and we need a new pricing rule that grants 20% off on the first Tuesday of every second month, we don’t need to change any code except for the code that initializes the hotels: we just implement the new functionality, without changing code that already works: that’s the Open/Closed Principle at play. In fact, I tried to depict all of SOLID in this code – I hope I did something like that.