Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleUse VBA to generate code to reproduce basic calculations on an Excel worksheet
DescriptionThis example shows how to use VBA to generate code to reproduce basic calculations on an Excel worksheet.
KeywordsVBA, generate code, calcualtion, Excel, worksheet
CategoriesOffice, Algorithms
 
The example code performs three tasks:

  1. Identify the cells that need calculation
  2. Put the cells in a valid execution order
  3. Generate VBA code to evaluate the cells' values

Note that this code handles only simple arithmetic operations and not worksheet formulas such as SUM and AVERAGE.

The CellInfo class shown in the following code holds information about a worksheet cell. The Cell property holds a reference to the cell's Range object in the worksheet. Its NumPrecedents and NumDependents properties hold the number of other cells that directly depend on this one.

The Initialize subroutine saves a reference to the cell's Range and then gets the cell's number of dependents and precedents. Note that if a cell has no dependents and precedents, then the Range's DirectPrecedents and DirectDependents properties don't exist and trying to access them raises an error so the code uses On Error to protect itself.

The VariableName function returns a suitable name for the cell. For example, the cell with address $D$3 has variable name cellD3.

The Equation function returns an equation for evaluating the cell in VBA code. It gets the cell's number of precedents again (the value is removed by the main subroutine described later). If the number of precedents is zero, then the cell contains a simple value so the function returns an assignment statement that gets the cell variable's value from the worksheet. If the cell has precedents, then the function returns the cell's formula with cell addresses replaced by VBA cell variable names.

The CellVariableName helper function returns a VBA variable name for a cell. For example, for $E$7 it returns cellE7.

Finally the SaveResults helper function returns a VBA statement that saves the VBA variable's value in the appropriate worksheet cell.

 
Public Cell As Range
Public NumPrecedents As Integer     ' The number of cells
    ' we depend on.
Public NumDependents As Integer     ' The number of cells
    ' that depend on us.

' Prepare the CellInfo object.
Public Sub Initialize(ByVal c As Range)
    Set Cell = c

    On Error Resume Next
    NumPrecedents = c.DirectPrecedents.Count
    NumDependents = c.DirectDependents.Count
    On Error GoTo 0
End Sub

' Return a VBA variable name for the cell.
Public Function VariableName() As String
    VariableName = CellVariableName(Cell)
End Function

' Return the VBA equation for the cell.
Public Function Equation() As String
Dim txt As String
Dim precedent As Range
Dim precedent_addr As String

    ' Get the number of precedents again.
    On Error Resume Next
    NumPrecedents = Me.Cell.DirectPrecedents.Count
    On Error GoTo 0

    If NumPrecedents = 0 Then
        ' It has no precedents.
        ' Just get the value from the worksheet's cell.
        txt = VariableName() & " = sheet.Range(""" & _
            Cell.Address & """)"
    Else
        ' Get the cell's basic equation.
        txt = Cell.Formula

        ' Remove $ signs.
        txt = Replace(txt, "$", "")

        ' Remove leading = sign.
        If Left$(txt, 1) = "=" Then txt = Mid$(txt, 2)

        ' Replace the precedent references with variable
        ' names.
        For Each precedent In Me.Cell.DirectPrecedents
            precedent_addr = Replace(precedent.Address, _
                "$", "")
            txt = Replace(txt, precedent_addr, _
                CellVariableName(precedent))
        Next precedent

        txt = VariableName() & " = " & txt
    End If

    Equation = txt
End Function

' Return a variable name for this cell.
Private Function CellVariableName(ByVal c As Range) As _
    String
    CellVariableName = "cell" & Replace(c.Address, "$", "")
End Function

' Return a VBA statement that saves this cell's results
' onto the worksheet.
Public Function SaveResults() As String
    SaveResults = "sheet.Range(""" & Cell.Address & """) = " & _
        "" & VariableName()
End Function
 
The following code shows the main subroutine that builds the VBA code. First it loops through every cell in the worksheet's UsedRange. If a cell has precedents (cells that it depends on), the code adds its CellInfo object to the not_ready collection. These are cells that need calculation but that cannot be calculated yet because their value depends on another cell's value.

If a cell has no precedents but has dependents (cells that depend on it), then the code saves a CellInfo object for the cell in the ready collection. These are cells that are needed for other calculations and that do not depend on any other cell. Their values are already entered on the worksheet.

While the ready list contains cells, the code moves the first cell from the ready collection to the calculation_list collection. This collection holds cells in an order in which they can be evaluated. For each cell that depends on the moved cell, the code decrements the dependent's NumPrecedents count. If the count reaches zero, then the cell is ready to be calculated so the code moves it to the ready list.

After it has emptied the ready list, all cells should have been moved into the calculation_list collection in an order that al;lows calculation. The code verifies this and displays a warning message if any cells are still in the not_ready list.

Finally the code generates the output VBA code. It builds a Sub statement and then loops through the cells declaring variables to hold their values. It then loops through the variables again, adding their equations to the output. Finally the code loops through the cells to make statements that save their values in the worksheet.

The code finishes by displaying the resulting VBA code in a form.

 
Private Sub ConvertFormulasToVBA()
Dim ready As Collection
Dim not_ready As Collection
Dim sheet As Worksheet
Dim c As Range
Dim cell_info As CellInfo
Dim dependent As Range
Dim i As Integer
Dim calculation_list As Collection
Dim dependent_info As CellInfo
Dim txt As String
Dim frm As dlgCode

    ' Get the cells that have formulas.
    Set sheet = ActiveSheet
    Set ready = New Collection
    Set not_ready = New Collection
    For Each c In sheet.UsedRange
        ' Get information about the cell.
        Set cell_info = New CellInfo
        cell_info.Initialize c

        ' If the cell has precedents, add it to the
        ' not_ready list.
        ' If it has dependents but not precedents, add it
        ' to the ready list.
        If cell_info.NumPrecedents > 0 Then
            not_ready.Add cell_info, c.Address
        ElseIf cell_info.NumDependents > 0 Then
            ready.Add cell_info, c.Address
        End If
    Next c

    ' Process the ready list until it's empty.
    Set calculation_list = New Collection
    Do While ready.Count > 0
        ' Move the first cell to the calculation list.
        Set cell_info = ready.Item(1)
        calculation_list.Add cell_info
        ready.Remove 1

        ' Decrement the precedent counts for the dependents.
        If cell_info.NumDependents > 0 Then
            For Each c In cell_info.Cell.DirectDependents
                ' Find this cell's entry in the not_ready
                ' list.
                Set dependent_info = _
                    not_ready.Item(c.Address)

                ' Decrement its precedent count.
                dependent_info.NumPrecedents = _
                    dependent_info.NumPrecedents - 1

                ' See if the cell now has no precedents.
                If dependent_info.NumPrecedents = 0 Then
                    ' Move it to the ready list.
                    ready.Add dependent_info
                    not_ready.Remove _
                        dependent_info.Cell.Address
                End If
            Next c
        End If
    Loop

    ' Make sure there wasn't a circular reference.
    If not_ready.Count > 0 Then
        txt = "Warning: There is a circular reference among " & _
            "the following cells:" & vbCrLf & "    "
        For Each cell_info In not_ready
            txt = txt & cell_info.Cell.Address & " "
        Next cell_info
        MsgBox txt, vbCritical Or vbOKOnly, "Circular " & _
            "Reference"
    End If

    ' We're done building the calculation list.
    ' Build the output.
    ' Declare variables.
    txt = ""
    txt = txt & "Private Sub EvaluateSheet(ByVal sheet As " & _
        "Worksheet)" & vbCrLf
    txt = txt & "' Declare variables." & vbCrLf
    For Each cell_info In calculation_list
        txt = txt & "Dim " & cell_info.VariableName() & " " & _
            "As Single" & vbCrLf
    Next cell_info

    ' Perform calculations.
    txt = txt & vbCrLf & "    ' Perform calculations." & _
        vbCrLf
    For Each cell_info In calculation_list
        txt = txt & "    " & cell_info.Equation() & vbCrLf
    Next cell_info

    ' Save results.
    txt = txt & vbCrLf & "    ' Save results." & vbCrLf
    For Each cell_info In calculation_list
        txt = txt & "    " & cell_info.SaveResults() & _
            vbCrLf
    Next cell_info

    txt = txt & "End Sub"

    ' Display the result.
    Set frm = New dlgCode
    frm.txtCode.Text = txt
    frm.txtCode.SelStart = 0
    frm.txtCode.SelLength = Len(txt)
    frm.Show
End Sub
 
To run the code, build a small subroutine that calls the generated EvaluateSheet routine, passing it the Worksheet that you want to evaluate. For example, the following code calls the subroutine for the currently active Worksheet.
 
Sub DoIt()
    EvaluateSheet ActiveSheet
End Sub
 
 
Copyright © 1997-2006 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated