|
|
Title | Use VBA to generate code to reproduce basic calculations on an Excel worksheet |
Description | This example shows how to use VBA to generate code to reproduce basic calculations on an Excel worksheet. |
Keywords | VBA, generate code, calcualtion, Excel, worksheet |
Categories | Office, Algorithms |
|
|
The example code performs three tasks:
- Identify the cells that need calculation
- Put the cells in a valid execution order
- 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
|
|
|
|
|
|