VBA

Introduction

There are many techniques one can use to write information from a running Microsoft Office program. You can save data in a workbook, but this is unwieldy for saving small items, such as program settings. You can use ini files or the registry, but both can get complicated. Using the registry is more invasive than you may want to be, and it’s very hard to transfer registry settings among computers. One of the easiest methods to save and retrieve data is by using simple IO commands with text files. Such files are small, they are processed rapidly, they can be read with a simple text editor, and they can be easily copied from computer to computer.

Visual Basic I/O

Visual Basic contains some commands which are useful for fast and simple text file input and output. Since the Visual Basic for Applications (VBA) used to program Microsoft Office is based on VB, Excel and the other Office applications can use these commands to read and write text files. I frequently use this technique to save application settings or to store debugging information.

The VBA help files contain detailed information about the various IO commands. Rather than beat the topic to death, I’ll present a couple simple examples that write and read text from a text file, then I’ll show some practical examples. The reader is directed to the help files for further details.

The subroutine TextIODemoWrite, shown below, opens a specified text file, puts a simple text string into the file, then closes the file. Files are opened using integers starting with 1; the FreeFile function assigns the next available integer to the file, to prevent accidentally assigning the same integer to two files. When you Open the file, a buffer is allocated to it, and the access mode (e.g., Output) is assigned. If the file does not already exist, it is automatically created. Subsequent commands (Write and Close) refer to the file using its integer. Text can be written using Write or Print; refer to the help files for specifics. Closing a file deallocates the buffer and disassociates the file from the file number.

Sub TextIODemoWrite()
  Dim sFile As String
  Dim sText As String
  Dim iFileNum As Integer

  sFile = "C:\test\textio.txt"
  sText = "Testing 1 2 3."

  iFileNum = FreeFile
  Open sFile For Output As iFileNum
  Write #iFileNum, sText
  Close #iFileNum
End Sub

The subroutine TextIODemoRead below shows the reverse operation, opening a text file, retrieving some text, closing the text file, then displaying the text in a message box.

Sub TextIODemoRead()
  Dim sFile As String
  Dim sText As String
  Dim iFileNum As Integer

  sFile = "C:\test\textio.txt"

  iFileNum = FreeFile
  Open sFile For Input As iFileNum
  Input #iFileNum, sText
  Close #iFileNum
  MsgBox sText
End Sub

Save and Retrieve Settings

The VBA procedures above can be expanded to allow us to save settings for later retrieval. The simplistic approach used in function SaveSetting reads variable names and values from a file, and writes them to a temporary file. If the named variable already exists, its new value is written to the temporary file in place of the existing value. When all variables have been read and written, the original file is replaced by the new file.

SaveSetting uses some additional functions, IsFullName, FullNameToPath, FullNameToFileName, and FileExists, which are shown at the end of this article.

Function SaveSetting(sFileName As String, sName As String, _
      Optional sValue As String) As Boolean
  
  Dim iFileNumA As Long
  Dim iFileNumB As Long
  Dim sFile As String
  Dim sXFile As String
  Dim sVarName As String
  Dim sVarValue As String
  Dim lErrLast As Long
  
  ' assume false unless variable is successfully saved
  SaveSetting = False
  
  ' add this workbook's path if not specified
  If Not IsFullName(sFileName) Then
    sFile = ThisWorkbook.Path & "\" & sFileName
    sXFile = ThisWorkbook.Path & "\X" & sFileName
  Else
    sFile = sFileName
    sXFile = FullNameToPath(sFileName) & "\X" & FullNameToFileName(sFileName)
  End If
  
  ' open text file to read settings
  If FileExists(sFile) Then
    'replace existing settings file
    iFileNumA = FreeFile
    Open sFile For Input As iFileNumA
    iFileNumB = FreeFile
    Open sXFile For Output As iFileNumB
      Do While Not EOF(iFileNumA)
        Input #iFileNumA, sVarName, sVarValue
        If sVarName <> sName Then
          Write #iFileNumB, sVarName, sVarValue
        End If
      Loop
      Write #iFileNumB, sName, sValue
      SaveSetting = True
    Close #iFileNumA
    Close #iFileNumB
    FileCopy sXFile, sFile
    Kill sXFile
  Else
    ' make new file
    iFileNumB = FreeFile
    Open sFile For Output As iFileNumB
      Write #iFileNumB, sName, sValue
      SaveSetting = True
    Close #iFileNumB
  End If
  
End Function

The function is called using this syntax (bTest is declared as a Boolean). The filename (with or without path), the variable name, and the value are all passed to the function as strings. If a path is not included as part of the file name, then the workbook’s own path is used. The value of the function is true unless an error is encountered.

bTest = SaveSetting("C:\test\settings.txt", "test variable", "test value")

Subroutine GetSetting enumerates the variables in the file until the named variable is found, then it extracts the value of this variable.

Function GetSetting(sFile As String, sName As String, _
      Optional sValue As String) As Boolean
  
  Dim iFileNum As Long
  Dim sVarName As String
  Dim sVarValue As String
  Dim lErrLast As Long
  
  ' assume false unless variable is found
  GetSetting = False
  
  ' add this workbook's path if not specified
  If Not IsFullName(sFile) Then
    sFile = ThisWorkbook.Path & "\" & sFile
  End If
  
  ' open text file to read settings
  If FileExists(sFile) Then
    iFileNum = FreeFile
    Open sFile For Input As iFileNum
      Do While Not EOF(iFileNum)
        Input #iFileNum, sVarName, sVarValue
        If sVarName = sName Then
          sValue = sVarValue
          GetSetting = True
          Exit Do
        End If
      Loop
    Close #iFileNum
  End If
  
End Function

The function is called using this syntax. The filename (with or without path) and the variable name are passed to the function as strings. The value of the function is true unless an error is encountered (i.e., the file or the variable is not found), and the value of the variable is passed back by the function.

If GetSetting("C:\test\settings.txt", "test variable", sValue) Then
  MsgBox sValue
End If

Save Debugging Information

During development or debugging of a program, it’s useful to save information during its execution. Subroutine DebugLog saves information in a text file with a name like debuglog051225.txt in the parent workbook’s directory. It saves the date and time along with the debug message, so the timing of the messages can be followed. You can log any string value, including markers indicating how far program execution has progressed, what the value of a key variable is, what an error may have occurred, etc.

Public Sub DebugLog(sLogEntry As String)
  ' write debug information to a log file

  Dim iFile As Integer
  Dim sDirectory As String
  
  sDirectory = ThisWorkbook.Path & "\debuglog" & Format$(Now, "YYMMDD") & ".txt"

  iFile = FreeFile

  Open sFileName For Append As iFile
  Print #iFile, Now; " "; sLogEntry
  Close iFile

End Sub

The following are a few examples of how to use DebugLog.

DebugLog "Starting Execution"

DebugLog "Variable MyVar = " & MyVar

DebugLog "Error " & Err.Number & ": " & Err.Description

The following is an excerpt from an actual debuglog file, debuglog051223.txt created by one of my old projects.

12/23/2005 8:00:33 AM  Excel Version 9.0, Build 8924
12/23/2005 8:00:33 AM  Program Starting
12/23/2005 8:00:33 AM  - File Name: ABC Engineering 2005-12-23-0.doc
12/23/2005 8:00:33 AM  - Order Number: ABC Engineering 2005-12-23-0
12/23/2005 8:00:38 AM  - saved as C:\Orders\ABC Engineering 2005-12-23-0.doc
12/23/2005 8:00:38 AM  - file exists: True
12/23/2005 8:00:38 AM  - no backup directory specified
12/23/2005 8:01:25 AM  - Checking Row 17: 3chars
12/23/2005 8:01:26 AM  - Checking Row 16: 3chars
12/23/2005 8:01:26 AM  - Checking Row 15: 3chars
12/23/2005 8:01:26 AM  - Checking Row 14: 3chars
12/23/2005 8:01:26 AM  - Checking Row 13: 3chars
12/23/2005 8:01:27 AM  - Checking Row 12: 3chars
12/23/2005 8:01:27 AM  - Checking Row 11: 3chars
12/23/2005 8:01:27 AM  - Checking Row 10: 3chars
12/23/2005 8:01:27 AM  - Checking Row 9: 15chars
12/23/2005 8:01:30 AM  - removing extra empty paragraphs
12/23/2005 8:01:56 AM  Program Finished

Supplementary Functions

Function IsFullName(sFile As String) As Boolean
  ' if sFile includes path, it contains path separator "\"
  IsFullName = InStr(sFile, "\") > 0
End Function

Public Function FullNameToFileName(sFullName As String) As String
  Dim iPathSep As Long
  iPathSep = InStrRev(sFullName, Application.PathSeparator)
  FullNameToFileName = Mid$(sFullName, iPathSep + 1)
End Function

Public Function FullNameToPath(sFullName As String) As String
  ''' does not include trailing backslash
  Dim iPathSep As Long
  iPathSep = InStrRev(sFullName, Application.PathSeparator)
  FullNameToPath = Left$(sFullName, iPathSep - 1)
End Function

Function FileExists(ByVal FileSpec As String) As Boolean
   ' by Karl Peterson MS MVP VB
   Dim Attr As Long
   ' Guard against bad FileSpec by ignoring errors
   ' retrieving its attributes.
   On Error Resume Next
   Attr = GetAttr(FileSpec)
   If Err.Number = 0 Then
      ' No error, so something was found.
      ' If Directory attribute set, then not a file.
      FileExists = Not ((Attr And vbDirectory) = vbDirectory)
   End If
End Function

Final Words

This article was originally posted on an old site which no longer exists. I was able to retrieve my work from this defunct site, so I am reposting it here as is. There are newer techniques for working with text files in Windows, but sometimes the old ways are as simple and effective as the new.

In Referencing Pivot Table Ranges in VBA I showed how to identify certain sections of a pivot table using VBA. In Dynamic Chart using Pivot Table and VBA I showed how to update a non-pivot chart when a pivot table updates.

How about some code that makes a chart based on only part of a pivot table, and updates it on demand?

The Pivot Table

The data we’re using shows causes of failure in a system, broken down by categories and types of failure. It’s the same data used in the dynamic chart article cited above.

Here’s the pivot table from the dynamic chart article. The duplicate columns Main Category and Category were needed in order to have the categories (electrical, mechanical, etc.) in both the row area and column area of the pivot table. Doing this plots each category’s defect data in a different series, so each category is shown in a different format.

If we just make a chart from the pivot table, here is the result. Not bad, but our objective is to show only one category, say, Environmental.

One of the limitations of a pivot chart is that we can’t plot a subset of the data. Well, we could, but we’d have to filter the pivot table so only the information we wanted to chart was visible.

Even if we selected only the data we wanted to plot, Excel would automatically expand the data range to the extent of the pivot table, and hand us a pivot chart.

We can still plot only part of the pivot table in a regular chart, but we need to take some special measures, as described in Making Regular Charts from Pivot Tables. For example, the selected range has to be nowhere near the pivot table when we insert the chart. Then we need to add the chart data one series at a time. Any attempt to enter a portion of the pivot table in the top portion of the Select Data Source dialog will convert the chart to a pivot chart and convert the source data range to the entire pivot table.

Chart Source Data in the Pivot Table

Basically, we need the subcategories of the environmental category for our X axis labels, we want the corresponding defect totals for our Y values, and we need the environmental category label for the series name.

I’ll use the approach I described in Referencing Pivot Table Ranges in VBA to identify these ranges.

The code to select the environmental category label (series name) is

ActiveSheet.PivotTables(1).PivotFields("Category").PivotItems("Environmental")
    .LabelRange.Select

Very good, the label is selected. One part done, the easy part.

If we use

ActiveSheet.PivotTables(1).PivotFields("Category").PivotItems("Environmental")
    .DataRange.Select

we would select the entire column of environmental defect data, including the blank cells for the other categories.

Likewise, if we try

ActiveSheet.PivotTables(1).PivotFields("Main Category").PivotItems("Environmental")
    .DataRange.Select

we end up with the entire row of data, including those blank cells.

What we need is the intersection of those two ranges, or

Intersect(ActiveSheet.PivotTables(1).PivotFields("Category")
    .PivotItems("Environmental").DataRange,
    ActiveSheet.PivotTables(1).PivotFields("Main Category")
    .PivotItems("Environmental").DataRange).Select

Perfect. Now for the category labels. Trying

ActiveSheet.PivotTables(1).PivotFields("Category").PivotItems("Environmental")
    .DataRange.Select

gives us all of the subcategories.

We only want some of those, so let’s poke around a little deeper.

ActiveSheet.PivotTables(1).PivotFields("Main Category").PivotItems("Environmental")
    .LabelRange.Select

gives us the four cells we want, but not in the right column.

So let’s use the interesection of the column of subcategory labels and the entire row of environmental data:

Intersect(ActiveSheet.PivotTables(1).PivotFields("Subcategory").DataRange,
    ActiveSheet.PivotTables(1).PivotFields("Main Category")
    .PivotItems("Environmental").DataRange.EntireRow).Select

Good, so we’ve figured out the ranges we’ll need.

Let’s Write Some Code

Now that we know what we’re starting with (a pivot table), how much of it we’ll need (the chart data ranges we divined above), and the output (a chart), it’s time to write some code.

I’ll do this in two parts. I’ll use a routine that updates a specified chart based on the ranges within the pivot table. I’ll write a routine that makes sure that the selected range doesn’t overlap with a pivot table and insert a new chart, then call the first routine to populate the chart. Finally I’ll write a short routine that calls the update chart routine, specifying the active chart.

The following routine accepts a chart from whatever code calls it, defines the various ranges it needs, uses the addresses of these ranges to construct the series formula, then clears the data out of the specified chart and replaces it with a series that uses this formula.

Sub UpdateChart(cht As Chart)
  Dim rXVals As Range
  Dim rYVals As Range
  Dim rName As Range
  Dim sSrsFmla As String
  Dim PT1 As PivotTable

  On Error GoTo LeaveThisMess

  ' define chart data ranges

  Set PT1 = ActiveSheet.PivotTables(1)

  Set rName = PT1.PivotFields("Category").PivotItems("Environmental").LabelRange

  Set rXVals = Intersect(PT1.PivotFields("Subcategory").DataRange, _
      PT1.PivotFields("Main Category").PivotItems("Environmental") _
      .DataRange.EntireRow)

  Set rYVals = Intersect(PT1.PivotFields("Category").PivotItems("Environmental") _
      .DataRange, PT1.PivotFields("Main Category").PivotItems("Environmental") _
      .DataRange)

  ' write series formula

  sSrsFmla = "=series(" & rName.Address(, , , True) & "," & _
      rXVals.Address(, , , True) & "," & rYVals.Address(, , , True) & ",1)"

  With cht
    ' clear out chart data
    Do
      If .SeriesCollection.Count = 0 Then Exit Do
      .SeriesCollection(1).Delete
    Loop

    ' add brand new series with data we've defined
    With .SeriesCollection.NewSeries
      .Formula = sSrsFmla
    End With
  End With

LeaveThisMess:

End Sub

The following routine moves the active cell to the bottom right cell of the sheet, where hopefully there won’t be any pivot tables. I could do more checking, but I won’t. Then the sheet is scrolled up to the top left cell.

It disables screen updating while it does this, so the user doesn’t get a case of vertigo.

The routine inserts a chart in the default position (centered in the window), makes it a clustered column chart, then sends the chart to the routine above to be populated for the first time.

Sub CreateChartFromPartialPivotTable()
  Dim cht As Chart

  Application.ScreenUpdating = False

  On Error GoTo BailOut

  ' make sure active cell isn't in pivot table
  ' if it were, the chart would be a pivot chart
  With ActiveSheet
    .Cells(.Rows.Count, .Columns.Count).Select
  End With
  With ActiveWindow
    .ScrollColumn = 1
    .ScrollRow = 1
  End With

  ActiveSheet.Shapes.AddChart
  Set cht = ActiveSheet.ChartObjects(1).Chart
  cht.ChartType = xlColumnClustered

  UpdateChart cht

  ActiveSheet.Cells(1, 1).Select

BailOut:
  Application.ScreenUpdating = True

End Sub

This last routine makes sure a chart is selected, and if so, calls the first routine to repopulate it.

Sub UpdateActiveChart()
  If Not ActiveChart Is Nothing Then
    UpdateChart ActiveChart
  End If
End Sub

Fairly elegant for something so quick and dirty.

Finally, The Chart

And oh yeah, here’s the chart. I’ve shown it next to the pivot table with the plotted series selected, so you can see the highlighted ranges used to plot the data. Environmental defect totals as Y values (blue highlights), environmental subcategories as X values (purple highlights), and Environmental label as series name (red highlight).