You are on the Home/Excel/VBA/Defensive Programming page
Google
Web This Site

Case Study – Defensive Programming

The material on this page is copyright © 2004-2006 Tushar Mehta

Defensive programming is the idea that the developer makes as few assumptions as absolutely necessary. In addition, the developer preemptively creates code that anticipates not only potential problems but also specification changes.  In this case study, which comes from someone who asked for my help with code that did not work consistently, we will explore some of the ideas behind defensive programming. As you will notice from her comments, things happened at times and other things – or nothing – happened at other times. The original code included some protective measures but we can improve on them since even that makes a few unnecessary assumptions. In addition, this is a classic example of code where one set of instructions does one thing and a subsequent set performs a contradictory function!

Defensive programming involves (a) finding problems in the existing code by identifying code inconsistencies and understanding typical uses of the software, (2) anticipating – and preempting – both potential problems with the existing specifications as well as likely changes in user behavior and design specifications, and (c) streamlining the code to aid readability and simplify maintainability.  A good defensive programmer is sufficiently confident in her abilities to ignore the traditional belief that “If it ain’t broke, don’t fix it.”  In fact the best defensive programmers will make preemptive changes to bring existing code in line with the norms of defensive programming.

By now you will have noted my aversion to comments that just describe what the code does. This case is no exception and has its share of such comments.  As we will see they add no value to understanding the code – and definitely not to understanding the intent behind the code.  As it turns out, the code had bugs in it.  However, the comments played no rule in solving the problem.  It was only by examining the data together with the code that one could find the programming errors.

Upon examination of the code it will become apparent that it plots the contents of columns F, G, and J.  Rather than wait until we get to that code, the relevant data columns are shown in Figure 1.

Figure 1

We will look at the original code in three segments labeled Beginning, Middle, and Ending.  A discussion of the pros and cons of each segment follows the code.  Following the discussion is the revised version of the code corresponding to that segment.  A summary follows the last discussion; complete code listings of both the original and the modified code are at the very end.

With that, we move on to an analysis of the code.

Option Explicit

 

Function DrawPerformanceChart(manager As String)

 

   ' declare variables for active sheet name and selected range

   Dim sSheet As String

   Dim rRange As Range

  

   Sheets("Dummy").Select

   sSheet = ActiveSheet.Name

 

   ' add chart and put it where you want it

   Charts.Add

   ActiveChart.Location Where:=xlLocationAsObject, Name:=sSheet

 

Code Sample 1 – The original beginning

The author has already done one thing right.  She structured the code as a function with an argument of ‘Manager.’  This means that it can be used to provide the same functionality for different managers.  What are the limitations?  Let’s start with the comments.  They add nothing to our understanding of the code.  If the reader doesn’t know that a Dim statement declares variables there isn’t much the comments will do to help.  For that matter, if the name of the variable isn’t sufficiently self-explanatory, it would be better to rename the variable than rely on a comment about its function.  Similarly, adding a chart and putting it in the correct location is self-evident in the code itself.  The comment adds nothing to the reader’s understanding of the code.

The other thing we can improve on is the use of the Select statement.  Typically, though not always, there is no need to activate or select objects.  It doesn’t add any value to the code other than degrade performance and, worse, leave the user not where he invoked our code but with something else selected altogether.  Rather annoying, wouldn’t you say?

Also note that while the developer structured the code as a function, she doesn’t return any result.  Even after reading the entire code, it is not clear if a Sub would have been more appropriate or if she meant to return a function value but forgot to do so.

The code assumes that the active workbook contains a worksheet named Dummy.  What if that isn’t true?  A defensive programmer might anticipate a missing worksheet and program that into the code.

Option Explicit

 

Function DrawPerformanceChart(manager As String) As Chart

   

    Dim SrcSheet As Worksheet, aChart As Chart

   

    On Error Resume Next

    Set SrcSheet = Worksheets("Dummy Sheet")

    On Error GoTo 0

    If SrcSheet Is Nothing Then

        MsgBox "Unable to create chart.  Worksheet named Dummy is missing."

        Exit Function

        End If

   

    Set aChart = Charts.Add()

    Set aChart = aChart.Location(Where:=xlLocationAsObject, _

        Name:=SrcSheet.Name)

Code Sample 2 – The revised beginning

OK, let’s continue with our analysis of the code.

 

   ActiveChart.ChartType = xlXYScatter

 ' Add first series (sometimes charts.add does, sometimes not)

   If ActiveChart.SeriesCollection.Count = 0 Then

      ActiveChart.SeriesCollection.NewSeries

   End If

 

  ' Define the data and type

   ActiveChart.SeriesCollection(1).Values = "=" & sSheet & "!R1C10:R16C10"

   ActiveChart.SeriesCollection(1).XValues = "=" & sSheet & "!R1C6:R16C6"

   ActiveChart.SeriesCollection(1).Name = "=""Gross Long"""

  

   ' Add second series (sometimes charts.add does, sometimes not)

   If ActiveChart.SeriesCollection.Count = 1 Then

      ActiveChart.SeriesCollection.NewSeries

   End If

   ' Define the data and type

   ActiveChart.SeriesCollection(2).Values = "=" & sSheet & "!R1C10:R16C10"

   ActiveChart.SeriesCollection(2).XValues = "=" & sSheet & "!R1C7:R16C7"

   ActiveChart.SeriesCollection(2).Name = "=""Gross Short"""

Code Sample 3 – The original middle

Note the use of Activechart.  While the Excel macro recorder generates such code, we should work away from it.  By using a variable of type Chart, we can easily avoid the reliance on ActiveChart, which makes the code rather specific and difficult to generalize.

The first few lines are the programmer’s attempt at writing defensive code.  She discovered – through trial and error, I suspect – that, by default, Excel creates a chart that may contain one or more series already plotted.  But, she also notes that this happens only some of the times.  Hence, the use of the If statement to add a new series only when necessary.  While a nice defensive measure, it is incomplete.  The code fails to address the possibility that Excel might create a chart with three or more series.  The safe way to handle this problem is to understand why the problem occurs in the first place.  If the selected cell and the surrounding region (given by the CurrentRegion property of the Range object) contain data, Excel uses a ‘best guess’ algorithm to create a chart using the data in the current region.  This means that we could have one, two, or even more series plotted in the chart.  How does one deal with this?  Reactively, one can deal with the problem by deleting all existing series in the chart.  That is preferred to trying to reuse a series if it already exists.  After all, we don’t even know what Excel has plotted.  Proactively, one could ensure that the active cell is one with an empty current region.

A second potential problem with the code that can be addressed with good defensive programming is the handling of the worksheet name.  Note the way in which sSheet is assigned a value and how it is subsequently used in the .Values and .XValues assignments.  In VBA, when a worksheet (or workbook) name that includes characters other than letters and numbers is used in a formula, the name must be enclosed in single quotes.  So, as long as the worksheet we are using is named Dummy, single quotes are not necessary.  However, what if someone were to change the name of Dummy to, say, Dummy Sheet?  Now the rest of the code would fail until and unless single quotes are added at the appropriate places.  Rather than wait for problems, a defensive programmer would add the quotes preemptively.

A third problem is the use of hardcoded ranges in the assignment statements for .Values and .XValues.  They specifically refer to rows 1 to 16.  A defensive programmer would anticipate the need that at some point the range being plotted would change (expand or even shrink).  In fact, in this case, if one were to look at the existing data, it will become obvious that while the code plots 16 rows, the data consists of 17!  This generalization could be done through the use of the End property of the Range object and then using the Address property of the resulting range.

The fourth issue is not a problem for certain – at least, not yet.  When taken in combination, the Values and XValues property assignments for the two series should raise a red flag.  Both Values assignments use the same column (column 10, i.e., column J) while the XValues assignments use different columns (columns 6 and 7, i.e., F and G, respectively).  While it is possible that that was the intent, it is not typical behavior.  In most cases where a chart consists of multiple series, each series plots different y-values and, if anything is the same, it is the x-values.  In addition, column J consists of a date while columns F and G contain percent value.  Again, while not definitive by itself, it is more likely that a chart will have dates on the x-axis and values on the y-axis.  In fact, as we will see with the subsequent code, this red flag is very justified – the subsequent code together with the data will indicate that the assignment statements are incorrect!

A final defensive programming note: while seemingly not a big deal, writing duplicate code is just not a good idea.  In this case, the duplicate code consists of one If statement and the subsequent assignment of the Values, XValues, and Name properties for each series.  As a matter of principle, this could be structured as a procedure with appropriate arguments.

Option Explicit

 

    Sub addASeries(ByRef aChart As Chart, _

            ByVal XRng As Range, ByVal YRng As Range, _

            ByVal SeriesName As String)

 

       With aChart

       .SeriesCollection.NewSeries

        With .SeriesCollection(.SeriesCollection.Count)

       .Values = "='" & YRng.Parent.Name & "'!" _

           & YRng.Address( _

           RowAbsolute:=True, ColumnAbsolute:=True, ReferenceStyle:=xlR1C1)

       .XValues = "='" & XRng.Parent.Name & "'!" _

           & XRng.Address( _

           RowAbsolute:=True, ColumnAbsolute:=True, ReferenceStyle:=xlR1C1)

        .Name = "=""" & SeriesName & """"

            End With

            End With

   

        End Sub

Function DrawPerformanceChart(manager As String)

   

'See Code Sample 1

 

    With aChart

    .ChartType = xlXYScatter

    Do While .SeriesCollection.Count > 0

        .SeriesCollection(1).Delete

        Loop

        End With

       

    With SrcSheet

    Set XValsRng = .Range(.Cells(1, 10), .Cells(1, 10).End(xlDown))

        End With

    Set YValsRng = XValsRng.Offset(0, -4)

    addASeries aChart, XValsRng, YValsRng, "Gross Long"

    addASeries aChart, XValsRng, YValsRng.Offset(0, 1), "Gross Short"

Code Sample 4 – The revised middle

 

Let’s look at the rest of the code.

 

   With ActiveChart

       .HasTitle = True

       .ChartTitle.Characters.Text = "Long Short Exposure " & manager

       .Axes(xlCategory, xlPrimary).HasTitle = True

       .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _

            "Reported Date"

       .Axes(xlValue, xlPrimary).HasTitle = True

       .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "% Exposure "

   End With

  

   ActiveChart.Axes(xlCategory).Select

   Selection.TickLabels.NumberFormat = "mmm-yy"

   With Selection.TickLabels.Font

       .Name = "Arial"

       .FontStyle = "Regular"

       .Size = 8

   End With

  

End Function

Code Sample 5 – The original ending

As before, a relatively straightforward problem is the use of select statements, which, as we have seen on numerous occasions, should be avoided when possible.

Another minor issue is the use of AxisTitle.Characters.Text While that is the code that the Excel macro recorder generates, one can simplify it to AxisTitle.Text.

One last point.  Remember the red flag mentioned in the discussion of Code Sample 3?  The developer put dates on the y-axis and percentage values on the x-axis.  Yet, in Code Sample 5 the formatting for those axes indicates she expected percentage values on the y-axis and dates on the x-axis.  Clearly something is amiss.

Option Explicit

'See Code Sample 4

   

Function DrawPerformanceChart(manager As String)

   

'See Code Sample 2 and Code Sample 4

 

    With aChart

    .HasTitle = True

    .ChartTitle.Text = "Long Short Exposure " & manager

    With .Axes(xlValue, xlPrimary)

    .HasTitle = True

    .AxisTitle.Text = "% Exposure "

        End With

    With .Axes(xlCategory, xlPrimary)

    .HasTitle = True

    .AxisTitle.Text = "Reported Date"

    .TickLabels.NumberFormat = "mmm-yy"

    With .TickLabels.Font

    .Name = "Arial"

    .FontStyle = "Regular"

    .Size = 8

        End With

        End With

        End With

        End Function

Code Sample 6 – The modified ending

Case study summary: The author of the code had already taken a few defensive programming measures.  We took several additional steps to ensure that we did not have to change the code whenever the data changed.  In addition, we found – and corrected – errors introduced by the original developer as to what range was plotted on what axis.  We also made a few optimization improvements by no longer requiring the activation and selection of various Excel worksheets and charts.  As with any case study, it is important to extract and understand the underlying essence of the specifics steps taken in this case study.  Defensive programming involves (a) finding problems in the existing code by checking for code inconsistencies and understanding typical uses of the software, (2) anticipating – and preempting – both potential problems with the existing specifications as well as likely changes in user behavior and design specifications, and (c) streamlining the code to assist readability and simplify maintainability.

The complete original code is shown in Code Sample 7.

Option Explicit

 

Function DrawPerformanceChart(manager As String)

 

   ' declare variables for active sheet name and selected range

   Dim sSheet As String

   Dim rRange As Range

  

   Sheets("Dummy").Select

   sSheet = ActiveSheet.Name

 

   ' add chart and put it where you want it

   Charts.Add

   ActiveChart.Location Where:=xlLocationAsObject, Name:=sSheet

   ActiveChart.ChartType = xlXYScatter

 

   ' Add first series (sometimes charts.add does, sometimes not)

   If ActiveChart.SeriesCollection.Count = 0 Then

      ActiveChart.SeriesCollection.NewSeries

   End If

 

  ' Define the data and type

   ActiveChart.SeriesCollection(1).Values = "=" & sSheet & "!R1C10:R16C10"

   ActiveChart.SeriesCollection(1).XValues = "=" & sSheet & "!R1C6:R16C6"

   ActiveChart.SeriesCollection(1).Name = "=""Gross Long"""

  

   ' Add second series (sometimes charts.add does, sometimes not)

   If ActiveChart.SeriesCollection.Count = 1 Then

      ActiveChart.SeriesCollection.NewSeries

   End If

   ' Define the data and type

   ActiveChart.SeriesCollection(2).Values = "=" & sSheet & "!R1C10:R16C10"

   ActiveChart.SeriesCollection(2).XValues = "=" & sSheet & "!R1C7:R16C7"

   ActiveChart.SeriesCollection(2).Name = "=""Gross Short"""

 

   With ActiveChart

       .HasTitle = True

       .ChartTitle.Characters.Text = "Long Short Exposure " & manager

       .Axes(xlCategory, xlPrimary).HasTitle = True

       .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _

            "Reported Date"

       .Axes(xlValue, xlPrimary).HasTitle = True

       .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "% Exposure "

   End With

  

   ActiveChart.Axes(xlCategory).Select

   Selection.TickLabels.NumberFormat = "mmm-yy"

   With Selection.TickLabels.Font

       .Name = "Arial"

       .FontStyle = "Regular"

       .Size = 8

   End With

  

End Function

Code Sample 7 – The complete original code

Finally, the complete revised code:

Option Explicit

 

    Sub addASeries(ByRef aChart As Chart, _

            ByVal XRng As Range, ByVal YRng As Range, _

            ByVal SeriesName As String)

 

       With aChart

       .SeriesCollection.NewSeries

        With .SeriesCollection(.SeriesCollection.Count)

       .Values = "='" & YRng.Parent.Name & "'!" _

           & YRng.Address( _

           RowAbsolute:=True, ColumnAbsolute:=True, ReferenceStyle:=xlR1C1)

       .XValues = "='" & XRng.Parent.Name & "'!" _

           & XRng.Address( _

           RowAbsolute:=True, ColumnAbsolute:=True, ReferenceStyle:=xlR1C1)

        .Name = "=""" & SeriesName & """"

            End With

            End With

   

        End Sub

Function DrawPerformanceChart(manager As String)

   

    Dim SrcSheet As Worksheet, aChart As Chart

    Dim XValsRng As Range, YValsRng As Range

   

    On Error Resume Next

    Set SrcSheet = Worksheets("Dummy Sheet")

    On Error GoTo 0

    If SrcSheet Is Nothing Then

        MsgBox "Unable to create chart.  Worksheet named Dummy is missing."

        Exit Function

        End If

   

    Set aChart = Charts.Add()

    Set aChart = aChart.Location(Where:=xlLocationAsObject, _

        Name:=SrcSheet.Name)

    With aChart

    .ChartType = xlXYScatter

    Do While .SeriesCollection.Count > 0

        .SeriesCollection(1).Delete

        Loop

        End With

       

    With SrcSheet

    Set XValsRng = .Range(.Cells(1, 10), .Cells(1, 10).End(xlDown))

        End With

    Set YValsRng = XValsRng.Offset(0, -4)

    addASeries aChart, XValsRng, YValsRng, "Gross Long"

    addASeries aChart, XValsRng, YValsRng.Offset(0, 1), "Gross Short"

 

    With aChart

    .HasTitle = True

    .ChartTitle.Text = "Long Short Exposure " & manager

    With .Axes(xlValue, xlPrimary)

    .HasTitle = True

    .AxisTitle.Text = "% Exposure "

        End With

    With .Axes(xlCategory, xlPrimary)

    .HasTitle = True

    .AxisTitle.Text = "Reported Date"

    .TickLabels.NumberFormat = "mmm-yy"

    With .TickLabels.Font

    .Name = "Arial"

    .FontStyle = "Regular"

    .Size = 8

        End With

        End With

        End With

        End Function

Sub testIt()

    DrawPerformanceChart "ABC"

    End Sub

Code Sample 8 – The complete modified code