Adding Excel Formulas – Part II

Last post showed the Fields Table column holding Excel Formulas to embed into your database result sets.  We also talked about how to enter formulas that reference database fields.  This is truly powerful stuff that turns basic data extracts into analytical information.  So let’s start adding the code that makes this all happen.

NOTE: If you added Build_SQL_Select_Fields prior to February 08, 2010, you’ll need to change that version to what is now posted in: Adding Tables and Columns to the Fields Table originally posted on 01/09/2010.  It contained an error.  Sorry.

Today’s code includes two functions: Add_XLFormula and Parse_XLFormula.  The change to Macro1() is shown at bottom.  The line to call Add_XLFormula  needs to be before sorting and formatting because the results can be treated just like fields retrieved from the database.  The in code documentation explains how to use the functions well enough – as it should.

Function Add_XLFormula(sDataRange As String, sFieldRange As String) As Boolean
      
'   Add_XLFormula: Add XL formula fields to results ONLY after data is loaded
'   Parameters:    sDataRange  = Name of range containing data
'                  sFieldRange = Name of range containing field definitions
'   Example:       bResult = Add_Defaults("Data", "Fields_Data")

'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
   
    Add_XLFormula = Failure       'Assume the Worst
    On Error GoTo ErrHandler

'   Dim Statements
    Dim lCol As Long              'Column in Data Range receiving formula
    Dim lRow As Long              'Current Row in Fields Table
    Dim lRows As Long             'Number of Rows in Fields Table
    Dim Formula As String         'Formula string
    Dim bIsArray As Boolean       'Is this an Array formula?
   
    Dim lColXLF As Long
        lColXLF = FieldColumn("XL Func.", sFieldRange)
   
    With Range(sFieldRange)
        For lRow = 2 To .Rows.Count
            sFormula = Trim(.Cells(lRow, lColXLF))
            If sFormula > "" Then
                'Check first if this is an Array Formula
                 bIsArray = Left(sFormula, 3) = """{=" Or _
                            Left(sFormula, 2) = "{="
                 If bIsArray Then
                     sFormula = Replace(sFormula, "{", "", 1, 1)
                     sFormula = Left(sFormula, Len(sFormula) - 1)
                 End If
                 
                 sFormula = Parse_XLFormula(lRow, sFormula, sFieldRange)
                 With Range(sDataRange)
                     lCol = lRow - 1
                     If Not bIsArray Then
                         Range(.Cells(2, lCol), _
                               .Cells(.Rows.Count, lCol)).FormulaR1C1 = _
                               sFormula
                     Else
                         .Cells(2, lCol).FormulaArray = sFormula
                         Range(.Cells(2, lCol), _
                               .Cells(.Rows.Count, lCol)).FillDown
                     End If
                 End With
            End If
        Next lRow
    End With
           
    Add_XLFormula = Success

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Add_XLFormula - Error#" & Err.Number & vbCrLf & Err.Description & vbCr _
            & sFormula, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
 
End Function

Function Parse_XLFormula(lFld As Long, sFormula As String, _
                         sFieldRange As String) As String
   
'   Parse_XLFormula:Create an XL formula using defintion in Fields Table
'   Parameters:     sFormula    A string containing a coded formula
'                   sFieldRange Name of Fields Table range

'   Example:        range("A4").FormulaR1C1 = _
'                       Parse_XLFormula(2, "=RC{MILES}/RC{GALLONS}", "Fields")

'   Notes:          sFormula can contain references to other Fields/Columns
'                   in the data range by placing {} around the Field/Column
'                   name.  This routine will replace these references with
'                   XL's R1C1 notation.  Examples:

'         Input     "=RC{MILES}/RC{GALLONS}"  Same as "={MILES}/{GALLONS}"
'         Result    "=R1C[3]/R1C[2]"          (Representative result)
'         Input     "=Sum(C{MILES})"          "C" w/no "R" gets entire column
'         Result    "=Sum(C[3])"              (Representative result)

'                   You may use the Field Name or the Heading.  I recommend
'                   using the Field Name because if you change the Heading
'                   the formula will break and you must change it as well

'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
'   02/05/10 CWH  Allowed Field or Heading to be used in Formula string
   
    On Error GoTo ErrHandler
    Parse_XLFormula = ""
   
    Dim i As Integer
    Dim lRow As Long
    Dim lRows As Long
    Dim lBeg As Long    'Start of Field Reference
    Dim lEnd As Long    'End of Field Reference
    Dim s As String     'Field Reference string
    Dim sRC As String   'Prefix for Cell Reference
   
    Dim lColFld As Long
        lColFld = FieldColumn("Field", sFieldRange)
    Dim lColHdg As Long
        lColHdg = FieldColumn("Heading", sFieldRange)
       
   'If user put formula in double quotes, remove them
    If Left(sFormula, 1) = """" Then 
        sFormula = Right(sFormula, Len(sFormula) - 1)
        If Right(sFormula, 1) = """" Then _
            sFormula = Left(sFormula, Len(sFormula) - 1)
    End If
    i = 0
       
    With Range(sFieldRange)
        lRows = .Rows.Count
        Do
           'Search for left curly bracket - designating start of a field
            lBeg = InStr(1, sFormula, "{")
            If lBeg > 0 Then
                lEnd = InStr(1, sFormula, "}")
               's equals name of a field, or heading in the Fields Table
                s = Mid(sFormula, lBeg + 1, lEnd - 1 - lBeg)
               'Determine if an RC reference was included
                sRC = UCase(Mid(sFormula, lBeg - 1, 1))
                If sRC <> "R" And sRC <> "C" Then
                    sRC = "RC"  'User didn't specify. Add RC (single cell)
                Else
                    sRC = ""    'User specified so don't add anything
                End If
               'Search Fields Table to determine field # referenced
                For lRow = 2 To lRows
                    If Trim(.Cells(lRow, lColFld)) = s Or _
                       Trim(.Cells(lRow, lColHdg)) = s Then
                        sFormula = Left(sFormula, lBeg - 1) & _
                                   sRC & "[" & lRow - lFld & "]" & _
                                   Right(sFormula, Len(sFormula) - lEnd)
                        Exit For
                    End If
                Next lRow
            End If
            i = i + 1
        Loop Until lBeg = 0 Or i = 20 'Limit to 20 references
    End With
               
    Parse_XLFormula = sFormula

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Parse_XLFormula - Error#" & Err.Number & vbCrLf & Err.Description, _
            vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0

End Function

Macro1() new line in red:

 
If NameExists("Data") Then
    If Range("Data").Rows.Count > 1 Then
        Add_XLFormula "Data", "Fields"
        Freeze_Pane "Data", "Fields"
        Sort_Data "Data", "Fields"
        Format_Results "Data", "Fields"
        Pivot_Template
    End If
End If