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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
'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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
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.
|
1 2 3 4 5 |
Public Property Get Commission() As Double Commission = Me.Sales.Total * Me.StandardRate End Property |
And in the CSales class:
|
1 2 3 4 5 6 7 8 9 10 11 12 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
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
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
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
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
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
Posting code? Use <pre> tags for VBA and <code> tags for inline.