Testing First

I’m not a TDD guy, but I am intrigued by it. With TDD, you write a test that fails and then write code to make it pass. Then you write another test that fails and write code to make it pass. Every so often you stop to refactor the code. I’m not an expert, so this may be overly simplistic or just plain wrong. If I used this methodology, I would end up with a crap load more tests than I do now. Maybe that’s a good thing.

What I like, in principal, about TDD is that nothing slips through the cracks. What I don’t like about it is that implementing it in VBA is probably a big headache. Mike Woodhouse has done some good work in this area, but I wanted to trying something simple from scratch to see what there is to see.

In my scenario, I’m computing commission for salesguys. A salesguy has a standard rate that he earns up to $100k of sales. From $100k to $500k, he gets 1.5 times that rate. And from $500k up, he gets 2x that rate. My first test is to check the commission on the first dollar.

'Salesguys get their standard rate up to $100k of sales, 1.5x standard rate up to $500k,
'and 2x over $500k

Sub testFirstDollarShouldBeAtStandardRate()

Dim clsSalesGuy As csalesguy
Dim clsSale As csale

Set clsSalesGuy = New csalesguy
Set clsSale = New csale

clsSale.SaleDate = #1/1/2012#
clsSale.amount = 1

clsSalesGuy.standardrate = 0.1

clsSalesGuy.sales.Add clsSale

Debug.Assert clsSalesGuy.commission = 0.1

End Sub

This doesn’t even compile. Literally all I did was add a module called MTest and write this test. I get no intellisense because I haven’t even created the classes yet. The first compile error is on the csalesguy line, so I’m going to create that class.

Private mlSalesGuyID As Long
Private mdStandardRate As Double
Private mclsSales As csales

Public Property Let SalesGuyID(ByVal lSalesGuyID As Long): mlSalesGuyID = lSalesGuyID: End Property
Public Property Get SalesGuyID() As Long: SalesGuyID = mlSalesGuyID: End Property
Public Property Let StandardRate(ByVal dStandardRate As Double): mdStandardRate = dStandardRate: End Property
Public Property Get StandardRate() As Double: StandardRate = mdStandardRate: End Property
Public Property Set Sales(ByVal clsSales As csales): Set mclsSales = clsSales: End Property
Public Property Get Sales() As csales: Set Sales = mclsSales: End Property

Private Sub Class_Initialize()

Set mclsSales = New csales

End Sub

Private Sub Class_Terminate()

Set mclsSales = Nothing

End Sub

Now I need a CSales class. I create a CSale class with SaleDate and Amount and use my VBHelpers add-in to create the CSales parent class. The next compile error is that I don’t have a Commission property of the CSalesGuy class.

Public Property Get Commission() As Double

Commission = Me.Sales.Total * Me.StandardRate

End Property

And in the CSales class:

Public Property Get Total() As Double

Dim clsSale As CSale
Dim dReturn As Double

For Each clsSale In Me
dReturn = dReturn + clsSale.Amount
Next clsSale

Total = dReturn

End Property

Everything compiles, I run my test, and it works. So far so good. Next I want to test just below the first threshold, so I add another test and a procedure to run all tests.

Sub testJustUnderFirstThresholdShouldBeAtStandardRate()

Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy

Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale

clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 100000

clsSalesGuy.Sales.Add clsSale

Debug.Assert clsSalesGuy.Commission = 10000

End Sub

Sub testAll()

testFirstDollarShouldBeAtStandardRate
testJustUnderFirstThresholdShouldBeAtStandardRate

End Sub

And they pass. I guess I didn’t write a test that failed, but I will this time. Next I want to test just over the first tier of sales.

Sub testFirstThresholdShouldBeAtHigherRate()

Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy

Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale

clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 100001

clsSalesGuy.Sales.Add clsSale

Debug.Assert clsSalesGuy.Commission = 10000.15

End Sub

That fails. So I fix my commission property.

Public Property Get Commission() As Currency

Dim dTotal As Double
Dim cReturn As Currency

dTotal = Me.Sales.Total

If dTotal > 100000 Then
cReturn = 100000 * Me.StandardRate + ((dTotal - 100000) * Me.StandardRate * 1.5)
Else
cReturn = dTotal * Me.StandardRate
End If

Commission = cReturn

End Property

Note that I changed the data type to Currency to eliminate the precision errors. This is obviously not optimal code, but I think the idea is to write the minimum code to make the test pass, then refactor. Next up, I test just under the next threshold.

Sub testJustUnderSecondThresholdShouldBeAtHigherRate()

Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy

Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale

clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 500000

clsSalesGuy.Sales.Add clsSale

Debug.Assert clsSalesGuy.Commission = CCur((100000 * 0.1) + (400000 * 0.15))

End Sub

That passes as expected. My last test case is over the second threshold.

Sub testSecondThresholdShouldBeAtHighestRate()

Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy

Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale

clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 500001

clsSalesGuy.Sales.Add clsSale

Debug.Assert clsSalesGuy.Commission = CCur((100000 * 0.1) + (400000 * 0.15) + (1 * 0.2))

End Sub

Now to fix up Commission to pass the test

Public Property Get Commission() As Currency

Dim dTotal As Double
Dim cReturn As Currency

dTotal = Me.Sales.Total

Select Case True
Case dTotal > 500000
cReturn = (100000 * Me.StandardRate) + (400000 * Me.StandardRate * 1.5) + ((dTotal - 500000) * Me.StandardRate * 2)
Case dTotal > 100000
cReturn = (100000 * Me.StandardRate) + ((dTotal - 100000) * Me.StandardRate * 1.5)
Case Else
cReturn = dTotal * Me.StandardRate
End Select

Commission = cReturn

End Property

And they all pass. Now I have only to refactor. That’s not insignificant as this is some really crappy code. The first thing I want to do is create a CRates class to hold all of the rates. The business rule of 1.5x and 2x is fine, but that could change so I need some flexibility. I create a CRate class with Rate and Threshold properties and make the parent CRates class a child of the CSalesGuy class. In CSalesGuy:

Private mclsRates As CRates

Public Property Set Rates(ByVal clsRates As CRates): Set mclsRates = clsRates: End Property
Public Property Get Rates() As CRates: Set Rates = mclsRates: End Property

Private Sub Class_Initialize()

Set mclsSales = New CSales
Set mclsRates = New CRates

End Sub

Private Sub Class_Terminate()

Set mclsSales = Nothing
Set mclsRates = Nothing

End Sub

Then I create a test setup function to instantiate the SalesGuy


Function testsetupSalesGuy() As CSalesGuy

Dim clsReturn As CSalesGuy
Dim clsRate As CRate
Dim dRate As Double

dRate = 0.1

Set clsReturn = New CSalesGuy
Set clsRate = New CRate
clsRate.Rate = dRate
clsRate.Threshold = 0
clsReturn.Rates.Add clsRate

Set clsRate = New CRate
clsRate.Rate = dRate * 1.5
clsRate.Threshold = 100000
clsReturn.Rates.Add clsRate

Set clsRate = New CRate
clsRate.Rate = dRate * 2
clsRate.Threshold = 500000
clsReturn.Rates.Add clsRate

Set testsetupSalesGuy = clsReturn

End Function

Finally, I need to change the Commission property to use the Rates rather than the (now eliminated) StandardRate property.

Public Property Get Commission() As Currency

Dim dTotal As Double
Dim cReturn As Currency
Dim clsRate As CRate

dTotal = Me.Sales.Total

For Each clsRate In Me.Rates
If dTotal > clsRate.Threshold Then
cReturn = cReturn + ((dTotal - clsRate.Threshold) * (clsRate.IncrementalRate))
End If
Next clsRate

Commission = cReturn

End Property

That requires an IncrementalRate property of the CRate class.

Public Property Get IncrementalRate() As Double

Dim clsRate As CRate
Dim clsNext As CRate
Dim dMax As Double

For Each clsRate In Me.Parent
If clsRate.Threshold >= dMax And clsRate.Threshold < Me.Threshold Then dMax = clsRate.Threshold Set clsNext = clsRate End If Next clsRate If clsNext Is Nothing Then IncrementalRate = Me.Rate Else IncrementalRate = Me.Rate - clsNext.Rate End If End Property

All of my tests pass, so I should be good right? It's nice to be able to refactor the code and see that all the results are still correct. I made the commission rates model more flexible to allow for an unlimited number of sales tiers, but I'm still only testing my original business rules. Maybe I should add more tests, but then it's not really the tests that drive the development. Do you write tests first? If so, how would you do it differently?

You can download TDD_VBA.zip

Posted in VBA

Leave a Reply

Your email address will not be published. Required fields are marked *