Well, this is just the type of thing Bill gates invented Visual Basic for. I’ll apply an approach related to that in my VBA Conditional Chart Formatting series: VBA Conditional Formatting of Charts by Series Name, VBA Conditional Formatting of Charts by Category Label, and VBA Conditional Formatting of Charts by Value, with a little help from Referencing Pivot Table Ranges in VBA. I’ll use arbitrary data and an arbitrary condition for the example.

Here is a data source for a simple pivot table. The entire range of values in column D consists of random integers between 1 and 9, and there are three categories by which they can be sorted.

The first pivot table, PivotTable1, has the category fields all placed in the rows area. I manually typed the name “Pivot Table 1″ in the cell above the pivot table.

Tip: To name a pivot table, right click on the table, choose Table Options, and edit the name in the first line of the dialog.

The second pivot table, PivotTable2, has one category in the columns area, so the values are separated into two columns.

I used the following VBA procedure to apply bold text and yellow fill formatting to rows in PivotTable1 if the value in the Total column is 7 or greater. We are testing the entire DataBodyRange, which is one column wide.

Sub FormatPT1()
  Dim c As Range
  With ActiveSheet.PivotTables("PivotTable1")

    ' reset default formatting
    With .TableRange1
      .Font.Bold = False
      .Interior.ColorIndex = 0
    End With

    ' apply formatting to each row if condition is met
    For Each c In .DataBodyRange.Cells
      If c.Value >= 7 Then
        With .TableRange1.Rows(c.Row - .TableRange1.Row + 1)
          .Font.Bold = True
          .Interior.ColorIndex = 6
        End With
      End If
    Next

  End With
End Sub
 

I used the next procedure to apply the same formatting to PivotTable2 rows if the value in column a under Category 3 is 7 or greater. The DataBodyRange is two columns wide, for pivot items “a” and “b”. To test against pivot item “a”, we test the pivot item’s DataRange.

Sub FormatPT2()
  Dim c As Range
  With ActiveSheet.PivotTables("Pivottable2")

    ' reset default formatting
    With .TableRange1
      .Font.Bold = False
      .Interior.ColorIndex = 0
    End With

    ' apply formatting to each row if condition is met
    For Each c In .PivotFields("Category 3").PivotItems("a").DataRange.Cells
      If c.Value >= 7 Then
        With .TableRange1.Rows(c.Row - .TableRange1.Row + 1)
          .Font.Bold = True
          .Interior.ColorIndex = 6
        End With
      End If
    Next

  End With
End Sub
 

The two procedures above belong in a regular code module.

Here is PivotTable1 with the conditional formatting applied.

Here is PivotTable2 with the same formatting applied.

Note that refreshing the pivot tables changes values but does not automatically reformat the tables. You have to manually rerun the VBA routines, or capture the PivotTableUpdate event:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
  Select Case Target.Name
    Case "PivotTable1"
      FormatPT1
    Case "PivotTable2"
      FormatPT2
  End Select
End Sub
 

This procedure goes in the code module for the worksheet that contains the pivot tables. To access this module easily, right click on the sheet tab, and choose View Code. If you use this approach, you can put the first two procedures into the worksheet’s code module, instead of a regular module.

Peltier Technical Services, Inc., Copyright © 2009.
 
Licensed under a Creative Commons Attribution-Noncommercial-Share Alike 3.0 Unported License.
 

The good news is that you don’t need to reformat every little element of every last chart. When you copy a chart, you can select another chart and go to Paste Special. The options in the Paste Special dialog are to paste the formulas (the data in the copied chart), the formats (from the copied chart), or both data and formatting.

Not only can you paste formats from one chart to another, you can write a little VBA to automate the process.

John Mansfield did just that in VBA to Copy Embedded Chart Formatting in his cellMatrix.net blog. I punched up John’s original code to get this procedure:

Sub Copy_Chart_Formats()

    Dim Sht As Worksheet
    Dim Cht As ChartObject

    Application.ScreenUpdating = False

    ActiveChart.ChartArea.Copy

    For Each Sht In ActiveWorkbook.Worksheets
        For Each Cht In Sht.ChartObjects
            Cht.Chart.Paste Type:=xlFormats
        Next Cht
    Next Sht

    Application.ScreenUpdating = True

End Sub
 

Let’s see how it works. Here are four charts, with different data and with different original chart types and formatting.

With the top left chart selected, running the program changes none of the data but all of the formatting of the charts (including the top left chart).

Closer inspection reveals the bad news, which is that not only are the formats changed to match the master chart, but so are the chart and axis titles. This would be horrible, to get the formats you wanted in all 200 charts in your workbook, but to also have 200 sets of titles to change back.

Fortunately we’re all expert programmers, with a thorough knowledge of Excel’s object model, so we recognize before even trashing all of our charts what steps we need to take.

First we’ll do a little check before reformatting a chart, to save us the fraction of a second it takes to redundantly reformat the original chart. Then we’ll extract the chart and axis titles, apply the master format to the chart (which hoses the titles), and finally reapply the titles.

Sub Copy_Chart_Formats_Not_Titles()

  Dim Sht As Worksheet
  Dim Cht As ChartObject
  Dim chtMaster As Chart
  Dim bTitle As Boolean
  Dim bXTitle As Boolean
  Dim bYTitle As Boolean
  Dim sTitle As String
  Dim sXTitle As String
  Dim sYTitle As String

  Application.ScreenUpdating = False

  Set chtMaster = ActiveChart

  For Each Sht In ActiveWorkbook.Worksheets
    For Each Cht In Sht.ChartObjects
      If Sht.Name = chtMaster.Parent.Parent.Name And _
          Cht.Name = chtMaster.Parent.Name Then
        ' don't waste time on chtMaster
      Else
        With Cht.Chart
          ' get titles
          bTitle = .HasTitle
          If bTitle Then
            ' chart title exists
            sTitle = .ChartTitle.Characters.Text
          End If
          If .HasAxis(xlCategory) Then
            bXTitle = .Axes(xlCategory).HasTitle
            If bXTitle Then
              ' axis title exists
              sXTitle = .Axes(xlCategory).AxisTitle.Characters.Text
            End If
          End If
          If .HasAxis(xlValue) Then
            bYTitle = .Axes(xlValue).HasTitle
            If bYTitle Then
              ' axis title exists
              sYTitle = .Axes(xlValue).AxisTitle.Characters.Text
            End If
          End If

          ' apply formats
          chtMaster.ChartArea.Copy
          .Paste Type:=xlFormats

          ' restore titles
          If bTitle Then
            .HasTitle = True
            .ChartTitle.Characters.Text = sTitle
          End If
          If bXTitle Then
            .Axes(xlCategory).HasTitle = True
            .Axes(xlCategory).AxisTitle.Characters.Text = sXTitle
          End If
          If bYTitle Then
            .Axes(xlValue).HasTitle = True
            .Axes(xlValue).AxisTitle.Characters.Text = sYTitle
          End If
        End With
      End If
    Next Cht
  Next Sht

  Application.ScreenUpdating = True

End Sub

As before, the master chart is selected, then its formatting is applied to all of the other charts in the workbook.

Nice, we’ve changed all of the formats while retaining the axis and chart titles. Instead of three minutes to reformat each chart (longer in 2007 because the F4 shortcut key for Repeat Last Action is no longer an effective timesaver), the whole process took seconds. Maybe a minute to copy and paste this code.

Pardon my French, but WTF?

To rub salt into the wound, this is followed up with an Out of Memory error:

Sometimes these occur once, sometimes twice, when Excel is started, when a workbook with code is opened, or when an add-in is opened.

Association with RefEdit Controls

Closer examination sheds some light on the problem. It seems to be related to our old friend, the RefEdit control. If a workbook or add-in has a UserForm with a RefEdit, this error may occur. When the error occurs, it may be impossible to view the UserForm in the VB Editor, or if the UserForm can be viewed, any RefEdits have been stripped off the form. UserForms without RefEdit controls can be viewed with no problems.

On a computer that experiences the problem, the RefEdit library (refedit.dll) is not available in the references under the VB Editor’s Tools menu,and sometimes it turns up as a MISSING reference in this list. The RefEdit library is also not found in the list of Additional Controls which can be added to the VBE’s Controls Toolbox. If the RefEdit control had been present on the Controls Toolbox, its place may be taken by a gray square with a tooltip of “Unknown”.

Interestingly enough, the RefEdit library is present on the machine, in the Microsoft Office program directory. But the library is apparently not accessible.

There have been some recent changes in the RefEdit control, I believe on more than one occasion, but I have never documented the changes. There are no outwardly visible differences in the control, but the file size has changed, the file created or modified date has changed, and the file version has changed.

History

This famous Unspecified Error, its hex code 80004005 burned into many a programmer’s retinas, has been around for a long time, in Visual Basic 6 and probably earlier. It has been blamed on many factors, many of which seem like wild guesses, and most of which are irrelevant to our situation here. There are a lot of instances in which this error occurred in projects which dealt with retrieval of data from data controls or databases (Access, Oracle, SQL Server, and others). This error has also been associated with ODBC, ADO, IMAP, ASP and IIS, and DLLs from Microsoft (INET and HTML controls) and third parties. I suspect that this is a catch-all error message when there is an internal error in VB, when there is no specific information but the error is somehow associated with various controls or libraries.

At least one Microsoft Knowledge Base article discusses this error in the context of Excel. OFF2000: “System Error &H80004005 (-2147467259)” Running Macro with UserForm attributes the error to opening a file with a userform that contains a Microsoft DirectAnimation Sprite control (daxctle.ocx), whatever that is. Apparently that was the Office 2000 version of the problem, and in Office 2003/2007 it’s kicked off by a RefEdit control.

Google finds innumerable links to this error in web sites and newsgroups, related to Visual Basic, Office, and recently, Excel. I have spent dozens of hours poring through search results looking unsuccessfully for relief.

What makes this problem so much harder to document and troubleshoot is that it does not occur on all computers which have had nominally the same upgrades. One user will be hobbled by this error, while a user in the adjoining cubical will show no signs of it. I have had substantially identical VMs on the same computer, some with the problem, some immune.

Remedies

This problem has surfaced among users of my charting utilities, but usually I’ve been able to fix it. Also, one of my clients has a large Excel add-in package which has experienced this error. So far I think we’ve successfully treated all infections. (And no, I’m not the Excel Doctor.)

I have tried a wide range of remedies. A few involve chicken’s blood at full moon, but most involve various Windows and Office activities. Some remedies work some of the time, but what works on one computer may not work on another.

Because this problem was sporadic when I first encountered it, I didn’t document the exact steps taken to diagnose and remedy the issue. I’ve generally followed a brute force approach until recently.

In mild cases, deleting all files in the user’s temp directory and in the C:\Documents and Settings\User Name\Application Data\Microsoft\Forms directory will clear up the problem. This is all that my main machine needed, but generally it’s like trying to boil the ocean.

Reregistering the refedit.dll does not seem to help. I have tried replacing an older version of this library with a newer version from another computer, but I don’t recall this ever having helped.

Lately it seems that almost all cases in Excel 2003 are fixed using the Help menu’s Detect and Repair command, so this is my first step in treating the malady. Excel 2007 has a similar command deep under the Office Orb (Excel Options > Resources > Run Microsoft Office Diagnostics > Diagnose). I’ve used this command, but it has never given me the same warm fuzzy feeling of a Detect and Repair operation. However, just today an end user ran the diagnostics, and the problem was cleared up.

There are a couple preventative measures which seem to make add-ins resistant to the unspecified error. Open the add-in in Excel 2000, uncheck the reference to the RefEdit library, compile the code (ignoring compile errors related to new Excel 2002-2003-2007 syntax), and save and close the add-in. The compile step may not be necessary. I’ve also removed RefEdit controls and replaced them in 2000, but this seems to be unnecessary (as well as tedious).

I’ve seen two or three cases in which these last few steps did not seem to work. But in at least one of these cases, I’m not sure the end user followed instructions and actually ran the Detect and Repair or Diagnostic command.

Update 23 June 2009

Bob Flanagan has shared a link to his detailed protocols for fixing this and other problems with Office installations at What to do if Excel add-ins do not run. Thanks, Bob.

Other Experiences

Have you encountered this problem? Have you documented it? Have you successfully treated it?

If so, I want to hear about it. Please leave a comment with as many details as you can muster.

- – -

This technique required seven columns of intricate calculations to portray the three series, the columns of formulas increase faster than the number of visible series in the chart, and the formulas become longer as series are added. Too much tedium, too many chances to mess it up.

Programmatic Approach

So I build a simple VBA routine. A1:D14 is the input data (the data need not start in A1). The first row contains series names and the cells are filled with the color to format the data points in the chart. The first column holds the category labels, and the data to be sorted and plotted is in B2:D14.

F1:L14 is the output data. The category labels and series names are copied over from the input range. (The bottom series in the chart is labeled with the first series name, regardless of which column of the original data provides the points for this series.) Each row of data values has been sorted left to right in decreasing order in G2:I14, and the series name corresponding to a particular data value is placed in the same cell within the range J1:L14.

Here is the chart created by the program.

This procedure works just as well if there are four or more initially columns of data, unlike the manual worksheet formula version, which is already getting bogged down at three columns.

Frankly, I’m not sure the charts with sorted columns are easier to read. In fact, when they are sorted it’s easier to keep track of which value goes with which series. With the blocks in different order for each stack, you have to keep referring to the legend. This negates any possible benefit of the blocks being in numerical order.

The VBA code is shown below. The procedure ProcessInputRange does all the work in the range passed to it. The procedure ProcessInputRangeSelection is run from Excel: it finds the selected range and passes it to ProcessInputRange. I separate my code into pieces like this to make it easier to reuse the pieces. For example, I could call ProcessInputRange from a different routine, perhaps cycling through all the sheets in a workbook and processing all of the data.

Sub ProcessInputRangeSelection()
  If TypeName(Selection) = "Range" Then
    ProcessInputRange Selection
  End If
  ActiveSheet.Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Select
End Sub

Sub ProcessInputRange(rInput As Range)
  ' range- and array-related
  Dim vaInput As Variant
  Dim vaYValues As Variant
  Dim vaXValues As Variant
  Dim vaNames As Variant
  Dim vaLabels As Variant
  Dim vYValueTemp As Variant
  Dim vLabelTemp As Variant
  Dim nXValues As Long
  Dim nNames As Long
  Dim iRow As Long
  Dim iCol As Long
  Dim iCol1 As Long
  Dim iCol2 As Long
  Dim rOutput As Range
  ' chart-related
  Dim lLeft As Double
  Dim lTop As Double
  Dim lWidth As Double
  Dim lHeight As Double
  Dim cht As Chart
  Dim iSeries As Long
  Dim iPoint As Long
  Dim vaColor As Variant

  vaInput = rInput.Value2

  nXValues = UBound(vaInput, 1) - 1
  nNames = UBound(vaInput, 2) - 1

  ReDim vaNames(1 To 1, 1 To nNames)
  ReDim vaXValues(1 To nXValues, 1 To 1)
  ReDim vaYValues(1 To nXValues, 1 To nNames)
  ReDim vaLabels(1 To nXValues, 1 To nNames)

  ' populate arrays
  For iRow = 1 To nXValues
    vaXValues(iRow, 1) = vaInput(iRow + 1, 1)
  Next
  For iCol = 1 To nNames
    vaNames(1, iCol) = vaInput(1, iCol + 1)
  Next
  For iRow = 1 To nXValues
    For iCol = 1 To nNames
      vaYValues(iRow, iCol) = vaInput(iRow + 1, iCol + 1)
      vaLabels(iRow, iCol) = vaNames(1, iCol)
    Next
  Next

  ' bubble sort values in each row, sort labels at same time
  For iRow = 1 To nXValues
    For iCol1 = 1 To nNames - 1
      For iCol2 = iCol1 + 1 To nNames
        If vaYValues(iRow, iCol2) > vaYValues(iRow, iCol1) Then
          vYValueTemp = vaYValues(iRow, iCol1)
          vaYValues(iRow, iCol1) = vaYValues(iRow, iCol2)
          vaYValues(iRow, iCol2) = vYValueTemp
          vLabelTemp = vaLabels(iRow, iCol1)
          vaLabels(iRow, iCol1) = vaLabels(iRow, iCol2)
          vaLabels(iRow, iCol2) = vLabelTemp
        End If
      Next
    Next
  Next

  ' put adjusted arrays into worksheet
  Set rOutput = rInput.Resize(1, 1).Offset(, nNames + 2)
  rOutput.Offset(, 1).Resize(, nNames).Value = vaNames
  rOutput.Offset(1).Resize(nXValues).Value = vaXValues
  rOutput.Offset(1, 1).Resize(nXValues, nNames).Value = vaYValues
  rOutput.Offset(1, 1 + nNames).Resize(nXValues, nNames).Value = vaLabels

  ' get colors
  With rInput.Offset(, 1).Resize(1, nNames)
    ReDim vaColor(1 To 1, 1 To nNames)
    For iCol = 1 To nNames
      vaColor(1, iCol) = .Cells(1, iCol).Interior.ColorIndex
    Next
  End With

  ' process chart
  lWidth = ActiveWindow.UsableWidth / 2
  lHeight = ActiveWindow.UsableHeight / 2
  lLeft = ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + lWidth / 2
  lTop = ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + lHeight / 2

  Set cht = ActiveSheet.ChartObjects.Add(lLeft, lTop, lWidth, lHeight).Chart

  With cht
    .SetSourceData Source:=rOutput.Resize(nXValues + 1, nNames + 1), PlotBy:=xlColumns
    .ChartType = xlColumnStacked

    .ChartGroups(1).GapWidth = 100
    With .PlotArea
      .Border.LineStyle = xlNone
      .Interior.ColorIndex = xlNone
    End With
    With .Axes(xlValue)
      .Border.LineStyle = xlNone
      With .MajorGridlines.Border
        .ColorIndex = 48
        .Weight = xlThin
      End With
    End With
    .Legend.Border.LineStyle = xlNone
    With .ChartArea
      .Border.LineStyle = xlNone
      .AutoScaleFont = False
      .Font.Size = 9
    End With

    ' format points
    For iSeries = 1 To nNames
      With .SeriesCollection(iSeries)
        .Border.LineStyle = xlNone
        .Interior.ColorIndex = vaColor(1, iSeries)
        For iPoint = 1 To nXValues
          For iCol = 1 To nNames
            If vaLabels(iPoint, iSeries) = vaNames(1, iCol) Then
              .Points(iPoint).Interior.ColorIndex = vaColor(1, iCol)
              Exit For
            End If
          Next
        Next
      End With
    Next

  End With

End Sub

To use the program, select your input data range, press Alt+F8 to bring up the Macro dialog, select ProcessInputRangeSelection, and press Run.

I wrote some code to create a new series based on the range next to the last series in the chart. The code copies the series formula from the last series, then edits the formula to reference the next column for the name and Y value parameters of the formula. Finally a new series is created, and the edited formula is assigned to this series.

Wonderful! One click to add each new series. Well, a few clicks, but it’s still much faster than the old way.

Then I embellished the routine, added some checks (is a chart selected, is the series formula well-formed, are the ranges readily manipulated, etc.), generalized it to series by rows as well as by columns, and ran a few tests. Worked like a charm.

Here’s a sample chart which initially uses the first three data columns as the Y values for its three series. (With the plot area or chart area selected, the source data range for the chart is highlighted.)

Run the macro: press Alt+F8, select the macro from the list, and click Run.

Here’s the result, which adds the fourth column as the chart’s fourth series.

Naturally, this can be changed using the Source Data dialog, or by dragging the colored outlines that indicate the source data. However, if the existing source data is in a pivot table, the chart would be converted to a pivot chart. Also, if the data is on another worksheet (or multiple worksheets), or if it is discontiguous or even more complicated, this is likely to produce unexpected results, or fail completely.

This procedure only requires that the last series have a series formula that it can parse. The added series is related only to the last series in the chart, using the next row or column in the worksheet.

Here is a chart that initially uses the first three rows of the data range for its three series.

After the macro is run, the chart has four series, using the first four rows of the data range.

Here’s the VBA procedure. If you’re not sure how to implement it, refer to my introductory VBA tutorial, How To: Use Someone Else’s Macro

Sub AddSeriesToEnd()
  '' Add series to active chart
  '' Use same X values
  '' Use Name and Y values one column to right of last existing series
  Dim sFmla As String
  Dim iParen As Long
  Dim sFmlaArgs As String
  Dim vFmlaArgs As Variant
  Dim sMsg As String
  Dim iOffset As Long
  Dim jOffset As Long
  Dim rValues As Range
  Dim rName As Range

  If ActiveChart Is Nothing Then
    sMsg = "Series Formula too complicated to parse"
    GoTo CantHandle
  End If

  With ActiveChart
    sFmla = .SeriesCollection(.SeriesCollection.count).Formula
    iParen = InStr(sFmla, "(")
    sFmlaArgs = Mid$(sFmla, iParen + 1)
    sFmlaArgs = Left$(sFmlaArgs, Len(sFmlaArgs) - 1)
    vFmlaArgs = Split(sFmlaArgs, ",")

    If UBound(vFmlaArgs) + 1 - LBound(vFmlaArgs) <> 4 Then
      sMsg = "Series Formula too complicated to parse"
      GoTo CantHandle
    End If

    On Error Resume Next
    Set rValues = Range(vFmlaArgs(2))
    Set rName = Range(vFmlaArgs(0))
    On Error GoTo 0

    If rValues Is Nothing Then
      sMsg = "Last series values are not in a range"
      GoTo CantHandle
    End If

    If rValues.Rows.count > 1 And rValues.Columns.count = 1 Then
      ' series in columns
      jOffset = 1
    ElseIf rValues.Rows.count = 1 And rValues.Columns.count > 1 Then
      ' series in rows
      iOffset = 1
    Else
      ' one cell or multiple rows and columns
      sMsg = "Series values range cannot be parsed"
      GoTo CantHandle
    End If

    vFmlaArgs(3) = vFmlaArgs(3) + 1
    If Not rName Is Nothing Then
      vFmlaArgs(0) = rName.Offset(iOffset, jOffset).Address(True, True, xlA1, True)
    Else
      vFmlaArgs(0) = "New Series " & vFmlaArgs(3)
    End If
    vFmlaArgs(2) = rValues.Offset(iOffset, jOffset).Address(True, True, xlA1, True)

    sFmlaArgs = Join(vFmlaArgs, ",")
    sFmla = Left$(sFmla, iParen) & sFmlaArgs & ")"
    With .SeriesCollection.NewSeries
      .Formula = sFmla
    End With
  End With

ExitSub:
  Exit Sub

CantHandle:
  MsgBox sMsg, vbCritical + vbOKOnly
  GoTo ExitSub
End Sub
 

There are a couple of shortcomings with the checkboxes-plus-formulas approach. If a series is not displayed, there is still a space for its bars in a column chart. Also, the legend key (marker in the legend) for the series is still present even if the label is hidden.

By using VBA and checkboxes together, these shortcomings can be avoided. This technique makes use of Excel’s default behavior, which does not show data in a chart if the data range is hidden. This behavior can be changed on a chart by chart basis, so that changing it for one chart does not change it for other charts.

Checkboxes and VBA

Start with a line or column chart that includes all of the series you will allow the user to select from (A, B, and C in this example). Add a checkbox from the Forms toolbar for each series.

The data is very simple, as shown below. The source data for the chart is in range J3:M8, and K1:M1 are the cells that the checkboxes are linked to. The range K1:M1 is named “TrueFalseRange” (select the range, click in the Name Box and type TrueFalseRange, and press ENTER).

In addition to the checkboxes being linked to cells in the TrueFalseRange, each is also assigned to a macro named ClickSeriesTextbox. The macro is very simple:

Sub ClickSeriesCheckbox()
    Dim rCell As Range
    For Each rCell In ActiveSheet.Range("TrueFalseRange").Cells
        rCell.EntireColumn.Hidden = Not rCell.Value
    Next
End Sub
 

All this macro does is check each cell in TrueFalseRange, if the value is False it hides the whole column, otherwise the column is displayed.

When (for example) the checkbox for Series B is unchecked, column L is hidden (signified by the thicker line between the column headers for columns K and M).

Series B is completely eradicated from the charts, leaving behind no spurious legend key, and no empty slot for Series B’s columns in the column chart.

If the user unchecks all of the checkboxes, all of the series value columns are hidden (note the darker line between the headers for columns J and N).

Not only are all series removed from the charts, but so are the axes, titles, legends, and other chart features. The chart is only visible in this screen shot because it has been activated.

CheckboxAndVBA.zip is a zipped workbook that illustrates this technique.

In How To: Fix a Recorded Macro I showed how to make a recorded macro more efficient by omitting and combining statements and eliminating the selection of objects during macro execution. This is a more specific example that makes the macro independent of the conditions (active sheet and selection) when it was recorded.

In this example, a macro is recorded after data is selected to capture the steps required to insert a chart object in the active worksheet. This recording was made in Excel 2003; the steps in 2007 are similar, and I’ll cover them in another post.

Here is our original data in C7:F13 of Sheet1:

The Recorded Macro

I recorded this simple macro while creating the chart, without changing any formatting:

Sub Macro1()
'
' Macro4 Macro
' Macro recorded 3/16/2009 by Jon Peltier
'

'
    Charts.Add
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("C7:F13")
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
End Sub
 

The worksheet name and selected range appear hard-coded in this macro. No matter what sheet is active or what range is selected, the chart will always appear on Sheet1 using the data in C7:F13 of Sheet1.

I will describe a couple ways to change this, both involving variables which are declared and assigned before the chart is created.

Fixing the Macro with String Variables

The sheet name and range address are present in the recorded macros as simple text. We can define string variables to contain the sheet name and the range address, as shown in this fixed macro.

Sub Macro1a()
'
' Macro4 Macro
' Macro recorded 3/16/2009 by Jon Peltier
' Fixed to use text variables for sheet and range

'
    Dim sSheetName As String
    Dim sDataRange As String

    sSheetName = ActiveSheet.Name
    sDataRange = Selection.Address

    Charts.Add
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    ActiveChart.SetSourceData Source:=Sheets(sSheetName).Range(sDataRange)
    ActiveChart.Location Where:=xlLocationAsObject, Name:=sSheetName
End Sub
 

Fixing the Macro with Object Variables

We can also use object variables, that is, a worksheet object for the active sheet and a range object for the data, as in the following fixed up macro.

Sub Macro1b()
'
' Macro4 Macro
' Macro recorded 3/16/2009 by Jon Peltier
' Fixed to use object variables for sheet and range

'
    Dim wksData As Worksheet
    Dim rngData As Range

    Set wksData = ActiveSheet
    Set rngData = Selection

    Charts.Add
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    ActiveChart.SetSourceData Source:=rngData
    ActiveChart.Location Where:=xlLocationAsObject, Name:=wksData.Name
End Sub
 

By adding only a few lines of code, the recorded macro has been made much more flexible. The choice whether to use string or object variables is not important in this case. In more complex procedures, one or the other approach may be advantageous, if a particular variable type is more useful later in the procedure.

Dick’s example was to replace this section of code:

On Error Resume Next
mcolMyCollection.Add oMyObject, CStr(oMyObject.ID)
On Error GoTo ErrorHandler
 

with this single line

AddToColl mcolMyCollection, oMyObject, CStr(oMyObject.ID)
 

that calls a small subroutine:

Public Sub AddToColl(col As Collection, vToAdd As Variant, sKey As String)
    On Error Resume Next
    col.Add vToAdd, sKey
    On Error GoTo 0
End Sub
 

This takes the interrupted error handling out of the main code, preventing a distracted programmer from turning it off altogether.

My suggestion was to turn the AddToColl subroutine into a function, which returns information to the calling sub. It might be a Boolean to indicate whether the action within the procedure was successful, or a Long (a User Defined Type) to indicate what error may have occurred, or as AlexJ suggested, a string containing an error message.

I often take a compound approach, where the function returns True or False to signify success, and an argument passes back to the calling procedure with an applicable message.

The following function is an example. It accepts the address of a range and returns a message as arguments, and returns True if the range meets the criteria.

Function NumericRangeValidator(sAddress As String, sMessage As String) As Boolean
  Dim rTest As Range

  ' false until it passes all tests
  NumericRangeValidator = False

  On Error Resume Next
  Set rTest = Range(sAddress)
  On Error GoTo 0

  ' is address a valid range
  If rTest Is Nothing Then
    sMessage = "Invalid address."
    GoTo ExitFunction
  End If

  ' is there anything in the range
  If WorksheetFunction.CountA(rTest) = 0 Then
    sMessage = "Empty range."
    GoTo ExitFunction
  End If

  ' is the range completely populated with numbers
  If WorksheetFunction.Count(rTest) < rTest.Rows.Count * rTest.Columns.Count Then
    sMessage = "Range not fully populated with numbers."
    GoTo ExitFunction
  End If

  ' if execution got this far, it's a valid range
  NumericRangeValidator = True

ExitFunction:

End Function
 

The message describes the problem with the range (invalid address, empty range, etc.), and only if all tests are passed is the value of the function True.

The following example shows how to use such a function. An If statement tests the value of the function. If it is true, the range is processed further by the calling code (in this case it performs a simple sum). If the function is false, the error message passed back by the function is displayed.

Sub TestNumericRangeValidator()
  Dim strAddress As String, strMessage As String

  strAddress = Selection.Address

  If NumericRangeValidator(strAddress, strMessage) Then
    ' process the successful range
    strMessage = "The sum of values in the range is " & WorksheetFunction.Sum(Range(strAddress))
    MsgBox strMessage, vbExclamation
  Else
    ' show the message
    MsgBox strMessage, vbCritical
  End If

End Sub
 

This approach is very flexible. The routine can be called from multiple places in a larger application. Each calling location can perform a different action based on the success of the function. The code above added the values, another routine could send it to a chart. If the range is not validated, the code above showed a message box, but it could have simply skipped the message box and died quietly. Or it could have shown the message in a label on a user form to explain to the user why the range they selected on the form cannot be used.

The benefit of passing arguments as well as an actual value for the function is I don’t have to test whether a string matches some stored string to determine whether the range was validated.

The line “Total Other Items” is a sum of the items below it in the list, and the chart does not show this subtotal. The series formula looks like:

=SERIES(Sheet1!$B$1,(Sheet1!$A$2:$A$4,Sheet1!$A$6:$A$8),
                    (Sheet1!$B$2:$B$4,Sheet1!$B$6:$B$8),1)
 

Notice both the X and Y arguments each consist of two ranges, separated by commas, and surrounded by parentheses. The reader inserted some items, both above and below the subtotal line:

The chart does not show the updated data. The series formula looks like:

=SERIES(Sheet1!$B$1,(Sheet1!$A$2:$A$4,Sheet1!$A$7:$A$9),
                    (Sheet1!$B$2:$B$4,Sheet1!$B$7:$B$9),1)
 

The reader wanted some way to show all of the individual items, and not the subtotal, dynamically or programmatically, to avoid the tedium of updating the chart manually whenever the range was changed. I suggested two ranges, one without the subtotal for charting, and one with the subtotal for the boss. My suggestion was rejected.

I dusted off an old VBA routine which I had originally written to keep zero and blank values out of a chart, and modified it to keep the subtotal line out. The routine redefined some names in the worksheet, and the names were used in the chart. The thing to do is run the routine once, then adjust the chart series formula to this:

=SERIES(Sheet1!$B$1,Book1!myARange,Book1!myMRange,1)
 

Now whenever thee VBA code is run, it redefines myARange and myBRange. Since the chart series is defined by these, running the code indirectly changes the chart as well. Here is a chart of the table above, updated with the changed names:

Assuming the data is in columns A and B, with headers in row 1 and actual data starting in row 2, and nothing clutters rows A and B beneath the data. This is the macro which, when run whenever the table is changed, will update the chart.

Sub FilterChartSourceDataRange()
  Dim myCell As Range
  Dim myARange As Range, myBRange As Range
  Dim nRow As Long, iRow As Long
  Dim sAvoid As String

  sAvoid = "Total Other Items"

  ' Find last row
  nRow = ActiveSheet.Cells(65536, "A").End(xlUp).Row

  For iRow = 2 To nRow
    Set myCell = ActiveSheet.Cells(iRow, "A")
    If myCell.Value <> sAvoid And Not IsEmpty(myCell) Then
      ' cell is okay, so add to charting ranges
      If myARange Is Nothing Then
        Set myARange = myCell
        Set myBRange = myCell.Offset(0, 1)
      Else
        Set myARange = Union(myARange, myCell)
        Set myBRange = Union(myBRange, myCell.Offset(0, 1))
      End If
    End If
  Next

  ' redefine ranges in worksheet
  ActiveWorkbook.Names.Add Name:="myARange", _
      RefersTo:="='" & ActiveSheet.Name & "'!" & myARange.Address
  ActiveWorkbook.Names.Add Name:="myBRange", _
      RefersTo:="='" & ActiveSheet.Name & "'!" & myBRange.Address

  ' clean up
  Set myCell = Nothing
  Set myARange = Nothing
  Set myBRange = Nothing
End Sub
 

Function CountBoldCellsInRange(rng As Range) As Long
  Dim rCell As Range
  Dim iBold As Long

  iBold = 0
  For Each rCell In rng
    If rCell.Font.Bold Then
      iBold = iBold + 1
    End If
  Next

  CountBoldCellsInRange = iBold
End Function
 

This function can be called in a number of ways. Here are two examples showing how to call the function from other VBA procedures.

Sub Test1CountBoldCellsInRange()
  Dim i As Long
  If TypeName(Selection) = "Range" Then
    i = CountBoldCellsInRange(Selection)
    MsgBox "There are " & i & " bold cells in the selected range."
  Else
    MsgBox "The selected object is not a range."
  End If
End Sub
 

Sub Test2CountBoldCellsInRange()
  Dim i As Long
  Dim r As Range
  Dim sAddress As String
  sAddress = "A1:F20"
  Set r = ActiveSheet.Range(sAddress)
  i = CountBoldCellsInRange(r)
  MsgBox "There are " & i & " bold cells in " & sAddress & "."
End Sub
 

You can even call it from a worksheet cell, using this syntax.

=CountBoldCellsInRange(A1:F20)