Beyond Excel: VBA and Database Manipulation


October 28, 2009  6:43 PM

Building a Library of Routines – Setup_Pivot

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

This next function is the heart and soul of creating Pivot Tables.  It’s purpose is to reduce the many Pivot Table properties and methods down to just one function and as few meaningful parameters as possible to create every Pivot Table my customers have every asked for.  Hopefully, your customers aren’t any more demanding.

Copy this to your modGeneral as before.  We will add one more routine for creating Pivot Charts, and then I will show you how to “snap” these routines into our Northwind data extract to create impactful graphs and dynamic drill downs. 

Function Setup_Pivot(sWorksheet As String, sDataRange As String, _
                     sTitle As String, sPageFields() As String, _
                     sRowFields() As String, sColumnFields() As String, _
                     sDataFields() As String, sSortFields() As String, _
                     sMaxFields() As String) As Boolean
'   Setup_Pivot:    Set up a Pivot Table Worksheet and Pivot Table
'   Parameters:    
'       sWorkSheet      - The worksheet name where the Pivot Table will be placed
'                         and the Pivot Table name.
'       sDataRange      - The data range (raw data/database extract)
'       sTitle          - A Title to put above the pivot table
'       sRowFields(#)   - Column headers in the data range that will appear
'                         down the left of the pivot table
'       sColumnFields(#)- Column headers in the data range that will appear
'                         across the top of the pivot table
'       sDataFields(#,2)
'                   #,0 = Column headers (field name) in the data range that
'                         will be in the body of the pivot table
'                   #,1 = Operation to be performed on the data (sum,count,etc.)
'                   #,2 = Caption to use for the resulting data field
'       sSortFields(#,2)
'                   #,0 = Row or Column field to sort
'                   #,1 = Ascending or Descending order
'                   #,2 = Data field to use to sort by
'       MaxFields(#,2)
'                   #,0 = Row or Column field to restrict
'                   #,1 = Max Number of entries to display
'                   #,2 = Data field to restrict by
'   Example:
'       Setup_Pivot sWorkSheet, sDataRange, sTitle, _
'                   sPageFields(), sRowFields(), sColumnFields(), sDataFields(), _
'                   sSortFields(), sMaxFields()
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming Copyright 2009 Craig Hatmaker
   
    On Error GoTo ErrHandler            '
    Setup_Pivot = Failure               'Assume the Worst
               
    Settings "Save"                     'Save current settings
    Settings "Disable"                  'Disable events, updating, calculations
   
'   Dim Statements
    Dim i As Integer
       
'   Check for the Pivot Table Worksheet and create it if it doesn't exist
    If Not WorkSheetExists(sWorksheet) Then
        Sheets.Add
        Sheets(ActiveSheet.Name).Name = sWorksheet
    Else
        Worksheets(sWorksheet).Activate
        Cells.Select
        Selection.Clear
    End If
    If PivotTableExists(sWorksheet, sWorksheet) Then
'       Just Refresh the Pivot Table if it already exists
        Worksheets(sWorksheet).PivotTables(sWorksheet).RefreshTable
    Else
'        Create the Pivot Table if it doesnt' exist
         ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
                                        SourceData:=sDataRange).CreatePivotTable _
                                        TableDestination:=Range("A4"), _
                                        TableName:=sWorksheet
         With ActiveSheet.PivotTables(sWorksheet)
            .SmallGrid = False
           
'           Add Pivot Table Page Field   
            For i = 0 To UBound(sPageFields())
                If sPageFields(i) <= "" Then Exit For
                With .PivotFields(sPageFields(i))
                   .Orientation = xlPageField
                   .Subtotals = Array( _
                     False, False, False, False, False, False, _
                     False, False, False, False, False, False)
                End With
            Next i
'           Add Pivot Table Row Fields   
            For i = 0 To UBound(sRowFields())
                If sRowFields(i) <= "" Then Exit For
                With .PivotFields(sRowFields(i))
                   .Orientation = xlRowField
                   .Subtotals = Array( _
                     False, False, False, False, False, False, _
                     False, False, False, False, False, False)
                End With
            Next i
'           Add Pivot Table Column Fields   
            For i = 0 To UBound(sColumnFields())
                If sColumnFields(i) <= "" Then Exit For
                With .PivotFields(sColumnFields(i))
                   .Orientation = xlColumnField
                   .Subtotals = Array( _
                     False, False, False, False, False, False, _
                     False, False, False, False, False, False)
                End With
            Next i
'           Add Pivot Table Data Fields, Function & Format   
            For i = 0 To UBound(sDataFields(), 1)
                If sDataFields(i, 0) <= "" Then Exit For
                With .PivotFields(sDataFields(i, 0))
                    .Orientation = xlDataField
                    If sDataFields(i, 1) <= "" Then sDataFields(i, 1) = "Count"
                    Select Case UCase(sDataFields(i, 1))
                        Case Is = "SUM"
                            .Function = xlSum
                        Case Is = "AVERAGE"
                            .Function = xlAverage
                        Case Is = "MAX"
                            .Function = xlMax
                        Case Is = "MIN"
                            .Function = xlMin
                        Case Is = "COUNTNUMS"
                            .Function = xlCountNums
                        Case Is = "PRODUCT"
                            .Function = xlProduct
                        Case Is = "STDEVP"
                            .Function = xlStDevP
                        Case Else
                            .Function = xlCount
                    End Select
                    .NumberFormat = "#,###.00_);[Red](#,###.00)"
                    If sDataFields(i, 2) <= "" Then sDataFields(i, 2) = _
                       sDataFields(i, 1) & " of " & sDataFields(i, 0)
                    .Caption = sDataFields(i, 2)
                End With
            Next i
'           Sort columns and rows   
            For i = 0 To UBound(sSortFields(), 1)
                If sSortFields(i, 0) <= "" Then Exit For
                If sSortFields(i, 1) = "Descending" Then
                    .PivotFields(sSortFields(i, 0)).AutoSort _
                    xlDescending, sSortFields(i, 2)
                Else
                    .PivotFields(sSortFields(i, 0)).AutoSort _
                    xlAscending, sSortFields(i, 2)
                End If
            Next i
'           Restrict to top/bottom entries   
            For i = 0 To UBound(sMaxFields(), 1)
                If sMaxFields(i, 0) <= "" Then Exit For
                If sMaxFields(i, 1) > 0 Then
                    .PivotFields(sMaxFields(i, 0)).AutoShow _
                    xlAutomatic, xlTop, Val(sMaxFields(i, 1)), sMaxFields(i, 2)
                Else
                    .PivotFields(sMaxFields(i, 0)).AutoShow _
                    xlAutomatic, xlBottom, Val(sMaxFields(i, 1)) * -1, _
                        sMaxFields(i, 2)
                End If
            Next i
        End With
 '      Orient datafields in columns         
        If UBound(sDataFields(), 1) > 0 Then
            With ActiveSheet.PivotTables(sWorksheet).DataPivotField
                .Orientation = xlColumnField
                .Position = 1
            End With
        End If
'       Freeze panes on row and column titles                  
        Range(ActiveSheet.PivotTables(sWorksheet).DataBodyRange.Address). _
            Cells(1, 1).Select
        ActiveWindow.FreezePanes = True
   
    End If
'   Add Worksheet Title   
    With Worksheets(sWorksheet)
        .Rows("1:1").MergeCells = False
        Range(.Cells(1, 1), .Cells(1, .PivotTables(sWorksheet).TableRange1. _
            Columns.Count)).Merge
        .Cells(1, 1) = sTitle
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 1).HorizontalAlignment = xlHAlignLeft
    End With
       
    Setup_Pivot = Success               'Successful finish
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Setup_Pivot - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"                  'Restore active window & settings
    On Error GoTo 0
End Function
 

How to Copy Code from this Blog to XL

  1. Open your XL spreadsheet containing modGeneral.
  2. Get to the VBE (Alt-F11)
  3. Open modGeneral in the Code Window
  4. From this post, select and copy the code
  5. Paste into the Code Window (*see next paragraph)
  6. Make any corrections to code that didn’t paste correctly
  7. From the VBE menu navigate File > Export File…
  8. Save modGeneral and remember where you saved it.

Unfortunately, the code won’t paste 100% properly.  You will have to add carriage returns and perhaps fix a few things until your code looks exactly like what you see here.

 

 

October 23, 2009  4:45 PM

Building a Library of Routines – Settings

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

Last post we added some small routines that tell us if various things exist so we can avoid trying to recreate what’s already there.  That avoids errors and speeds things along.  Another speed enhancer for just about any VBA routine is to shut off screen updating and calculations.  And if you ever create a routine that handles worksheet events (and I do), disabling those events while you make changes to worksheets prevents infinite loops and other problems.

The Settings routine handles turning those things off and back on.  Specifically, it is intended to:

  1. Save the current ActiveSheet, ScreenUpdating, EnableEvents, and Calculation properties
  2. Disable them before processing begins
  3. Restore them after processing ends

Three values alert Settings to which of those three functions it’s supposed to perform.  Those values are: “Save”, “Disable”, and “Restore”.  There are two other values Settings responds to.  They are: “Clear” and “Debug” which are intended to facilitate development and debugging.  “Clear” removes any saved settings.  “Debug” displays the current settings in the Immediate Window.

I like to call “Settings” from button handlers, other event handlers, and routines that could potentially be long running and make changes to the screen.  

Below is the code.  To copy this routine:

  1. Get to the VBE (Alt-F11)
  2. From the VBE menu navigate File > Import File…
  3. Load modGeneral (see previous post) 
  4. Select and copy the code below
  5. Paste into the Code Window  *
  6. Make any corrections to code that didn’t paste correctly
  7. From the VBE menu navigate File > Export File…
  8. Save modGeneral

* Unfortunately, the code won’t paste 100% properly.  You will have to add carriage returns and perhaps fix a few things until your code looks exactly like what you see here.  If someone knows a better method, please let me know so I can improve this blog.  Thanks.

Next Post: Setup_Pivot – a function for creating Pivot Tables from code.

 

Function Settings(sMode As String) As Boolean
'   Settings:       Saves, sets, and restores current application settings
'   Parameters:     sMode - "Save", "Restore", "Clear", "Disable", "Debug"
'   Example:        bResult = Settings("Disable")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming Copyright 2009 Craig Hatmaker
    On Error GoTo ErrHandler
    Settings = Failure                  'Assume the worst
   
    Static Setting(999, 4) As Variant  'Limit to 1,000 settings, prevent loops
    Static iLevel As Integer
    Select Case UCase(Trim(sMode))
        Case Is = "SAVE"
            Setting(iLevel, 0) = ActiveSheet.Type
            Setting(iLevel, 1) = ActiveSheet.Name
            Setting(iLevel, 2) = Application.EnableEvents
            Setting(iLevel, 3) = Application.ScreenUpdating
            Setting(iLevel, 4) = Application.Calculation
            iLevel = iLevel + 1
       
        Case Is = "RESTORE"
            If iLevel > 0 Then
                iLevel = iLevel - 1
                If Setting(iLevel, 0) = -4167 Then
                    Worksheets(Setting(iLevel, 1)).Activate
                Else
                    Charts(Setting(iLevel, 1)).Activate
                End If
                Application.EnableEvents = Setting(iLevel, 2)
                Application.ScreenUpdating = Setting(iLevel, 3)
                Application.Calculation = Setting(iLevel, 4)
            End If
      
        Case Is = "CLEAR"
            iLevel = 0
            Application.EnableEvents = True
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
           
        Case Is = "DISABLE"
            Application.EnableEvents = False
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
           
        Case Is = "DEBUG"
            Debug.Print iLevel, _
            Setting(iLevel, 0), _
            Setting(iLevel, 1), _
            Setting(iLevel, 2), _
            Setting(iLevel, 3), _
            Setting(iLevel, 4), _
   
    End Select
    Settings = Success           'Normal end - no errors
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Settings - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function


October 22, 2009  4:26 PM

Building a Library of Routines – ?Exists

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

We are early in the process of building a library of routines that will make creating analytical reports from database extracts a snap.  In our last post I explained the basic template that provides the skeleton for just about every function I write. 

Today, we are adding our first functions to our library - 5 of them.  These functions test to see if certain objects exist in our spreadsheet so we’ll know if we need to create them, or just refresh them (in some cases).   The first thing we need to do is create a module to contain these routines. 

  1. Get to the VBE (Alt-F11)
  2. From the VBE menu navigate Insert > Module
  3. Rename the new Module from Module1 to modGeneral (using the Properties Window). 
  4. Select and copy the code below
  5. Paste into the Code Window (*see next paragraph)
  6. Make any corrections to code that didn’t paste correctly
  7. From the VBE menu navigate File > Export File…
  8. Save modGeneral and remember where you saved it.

Unfortunately, the code won’t paste 100% properly.  You will have to add carriage returns and perhaps fix a few things until your code looks exactly like what you see here.  Yes – it’s a pain.  But it’s easier than typing it yourself and far easier than writing from scratch.  (If someone knows a better method, please let me know so I can improve this blog.  Thanks.)

Next Post: Settings routine – This routine puts XL on hold while VBA code runs to speed it along and prevent XL Worksheet events from firing when they shouldn’t.

'Version: 10/14/2009
'General Spreadsheet Routines
Option Explicit
Global Const Success = False
Global Const Failure = True
 

 

Function NameExists(sName As String) as Boolean
'   NameExists:     Determine if a name exists in a spreadsheet
'   Parameters:     sName - Name to be checked
'   Example:        If Not NameExists("Data") then Setup_Data("Data")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    NameExists = False     'Assume not found
   
    Dim objName As Object
   
    For Each objName In Names
        If objName.Name = sName Then
            NameExists = Right(Names(sName).Value, 5) <> "#REF!"
            Exit For
        End If
    Next
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "NameExists - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 
Function ShapeExists(sName As String) as Boolean
'   ShapeExists:    See if a Shape Exists
'   Parameters:     sName - Shape Name to be checked
'   Example:        If not ShapeExists("EasyButton") then _
'		    Create_Easy_Button "easy", "Show_Prompt", 10, 8
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    ShapeExists = False     'Assume not found
   
    Dim objName As Object
   
    For Each objName In ActiveSheet.Shapes
        If objName.Name = sName Then
            ShapeExists = True
            Exit For
        End If
    Next
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "ShapeExists - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 
Function WorkSheetExists(sName As String) as Boolean
'   WorkSheetExists:See if a Worksheet Exists
'   Parameters:     sName - Worksheet Name to be checked
'   Example:        If not WorkSheetExists("Data") then Setup_Data("Data")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    WorkSheetExists = False     'Assume not found
   
    Dim objName As Object
   
    For Each objName In Worksheets
        If objName.Name = sName Then
            WorkSheetExists = True
            Exit For
        End If
    Next
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "WorkSheetExists - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 
Function PivotTableExists(sWorksheet As String, sName As String) as Boolean
'   PivotTableExists:See if a PivotTable Exists
'   Parameters:     sName - PivotTable Name to be checked
'   Example:        If not PivotTableExists("pvtHrs") then Setup_pvtHrs
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
   On Error GoTo ErrHandler
    PivotTableExists = False     'Assume not found
   
    Dim objName As Object
   
    For Each objName InWorksheets(sWorksheet).PivotTables
        If objName.Name = sName Then
            PivotTableExists = True
            Exit For
        End If
    Next
   
ErrHandler:
   
    If Err.Number <>0 Then MsgBox _
        "PivotTableExists - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
 
Function ChartExists(sName As String) as Boolean
    
'   ChartExists:    See if a Chart Exists
'   Parameters:     sName - Chart Name to be checked
'   Example:        If not ChartExists("chtHrs") then Setup_chtHrs
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    ChartExists = False     'Assume not found
    Dim objName As Object
   
    For Each objName In Charts
        If objName.Name = sName Then
            ChartExists = True
            Exit For
        End If
    Next
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "ChartExists - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function


October 21, 2009  4:36 PM

Building a Library of Routines – Template

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

Up until now, I have been showing you how to record and modify macros to bring data into a spreadsheet, format it, display it in a pivot table, and chart it.  While this method works, it leaves some housekeeping problems to be solved everytime you do it.  Enough. 

This post starts us on the path of creating a library of functions to “snap together” and (in a very few cases) modify to quickly produce our final product, ready for delivery to our waiting customers (Users). 

The first function, however, isn’t a function (sorry).  It’s a template for all other functions.  We’ll get this, and some theory, out of the way and then get right into building our library.  Here is the template:

'Template
'Use this to create your own functions.  The basic idea is everything that isn't
'tied to a button should be a function.  Functions can be called like Subroutines
'but can also be checked for Success or Failure return codes if needed.
'1) Replace every instance of "Template" to your routine's name
'2) Change the "As Boolean" if your function returns something other than
'   Success or Failure
Function Template() As Boolean
'   Routine Name:  Description of Routine
'   Parameters: None
'   Example:    bResult = Template(Parm1, Parm2)
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler            '
    Template = Failure                  'Assume the Worst
'   Begin code here
'   End code here
   
    Template = Success                  'Successful finish
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Template - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
'   Begin additional error cleanup processing code here
    On Error Resume Next    'Remove this if no additional error cleanup processing
'   End   additional error cleanup processing code here
    On Error GoTo 0
End Function

The above template uses two user defined global constants: Success and Failure.  These constants provide more meaningful results for return codes than just True or False.  To define these constants and make them available throughout your project, you must add this tiny bit of code at the top of your module:

'Version: 10/09/2009
'General Spreadsheet Routines
Option Explicit
Global Const Success = False
Global Const Failure = True

This includes a comment to identify the version of your module.  Any time you change your module and save it, it’s a good idea to identify the version using the date.

I have also included a brief description of our library “General Spreadsheet Routines“.

The Option Explicit is a preference of mine.  It tells the VBA compiler not to accept any variables that haven’t been defined.  I use this because I make mistakes and I’d rather the compiler tell me when I have forgotten to properly define a variable than have my customers call me about a bug in my code.  If you don’t make mistakes, then by all means, remove this line – it’s useless otherwise.

Now – back to the template.  As you can see, there’s not much to it.  It’s just a shell with some error handling and places to put standard documention. 

Standard Documentation
It’s been my experience that most coders like to see a few things on any routine they might have to work on that they didn’t create themselves.  They want:

  • A brief description of the routine (why it’s important)
  • Defninitions for the parameters (if any)
  • An example of how to use the routine
  • A list of guilty parties, when they committed their crimes, and what the heck they were thinking

Error Handling
Like I said, I make mistakes.  Sometimes, so does XL/Windows.  That’s why error handling is critical.  You hope your users never experience an error, but if they do, they better never be plopped into your code.  They won’t know what to do and you’ll get a frustrated user’s call.  Only coders should see code.  So to make sure that happens, every routine should have error handling, and the first thing every routine does is to turn it on with “On Error GoTo ErrHandler”.

The second thing is to provide your routine with a default end state.  Most often, that’s Failure so unless your routine gets all the way to the end, it will accurately return Failure, not Success, and give the calling routine a chance to deal with it.

Many coders like to put an “Exit Function” just before the error handling routine.  I don’t.  I think it’s confusing.  Instead, I test for errors (If Err.Number <> 0 ).  If there are any, I leverage VBA’s error descriptions and present the user with an alert with whatever text VBA provides.  Hopefully, I’m the only one seeing these alerts during my testing.  In that case, the descriptions help greatly.  In any case, an alert is far better for the end user than being dumped into code.

In almost all cases, the error handling routines in the template work without modification, except for changing the name “Template” in the line “”Template – Error#” & Err.Number & vbCrLf & Err.Description, “.

To use the template, copy it, paste it, search and replace all instances of “Template” to your routine’s name, fix the documentation, and add code where designated.

Next posts: WorkSheetExistsPivotTableExists, ChartExists routines followed by: Settings; Setup_Pivot;  Setup_PivotChart; and finally, the Pivot_Template, the only routine in this bunch you’ll need to modify to easily make pivot tables and charts for your data.  Stay tuned.


October 17, 2009  4:15 PM

Pivots and Charts

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
So far, we have simplified listing data in XL.  For some XL users, that might be enough.  But for most users, this is only slightly better than printing data on green bar paper.  To really wow them, we need to leverage two of XL’s built in functions, Pivot Tables and Charts. 

Charts
Data is easier to understand when presented visually, like this: 

Chart

This chart shows the top 20 products (by quantity) sold by state.  This is the kind of chart most sales organizations require.  “But wait! There’s more!”

Drill Down
Once a sales organization sees their data, often they want to “drill down” to understand it better.  XL’s Pivot Tables support drill down and they make great source data from which to create charts like the one above.  Here is the supporting Pivot Table.

PivotTable

From this Pivot Table, users can “double click” on any value to “drill down” and see the detail entries.  Below are the results of double clicking the “55” at the intersection of “OR” and “Northwind Traders Chocolate Biscuits Mix” 

Drill Down

So rather than build the chart first, I always build a pivot table then create a pivot chart from it.  Now before attempting to build this chart, we need to add a little more data to our Query Table.  Below is the expanded SQL statement.  Add it to your macro.

.CommandText = Array( _
    "SELECT O.`Order ID`, O.`Customer ID`, O.`Order Date`, C.`First Name`, " & _
            "O.`Ship State/Province`, D.Quantity, P.`Product Name` " & vbCr, _
    "FROM   Customers C, Orders O, `Order Details` D, Products P " & vbCr, _
    "WHERE  O.`Customer ID` = C.ID " & vbCr & _
    "  AND  O.`Order ID`    = D.`Order ID` " & vbCr & _
    "  AND  D.`Product ID`  = P.ID " & vbCr & _
    "  AND  C.`State/Province` LIKE '" & s & "'")

Now, to add the same Pivot Table and Chart to your macro you could:

  • Click the “easy” button to bring in the expanded data set
  • Turn on the Macro recorder
  • Insert > Pivot Table > Pivot Chart
  • Put Quantity in the Data area; State in the columns; and Product Description in the rows
  • Click the down triangle on the Product Description header: select More Sort Options > Descending (Z to A) by: > Sum of Quantity
  • Click the down triangle again: select Value Filters > Top 10: and change 10 to 20
  • Right click the chart: Move Chart > New Sheet
  • Go to the chart tab and change the chart type to columns stacked
  • Turn off the Macro recorder
  • Go into the VBA editor
  • Cut and paste the newly recorded code just before the last END IF of Macro1.
     
    -OR-

You could use routines from my next posts to do the job and take care of some housekeeping problems you’ll discover when you try to rerun the macro you recorded.


October 14, 2009  9:05 PM

A Little Polish

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

In the last post we cleaned up what the macro recorder generated.  Today we fix one more user interface (UI) problem.  Today we will replace the generic “Enter Parameter Value” with a more meaningful input box.  Here is what it will look like:

InputBox
Input boxes are very simple.  Limited.  But simple.  Below is the code.  This bit must be added just after the: Sub Macro1()
   
Dim s As String
   
s = Trim( _
         InputBox("Enter State Code:" & vbCr & vbCr & _
             "'%' is a wildcard.  By itself it will retrieve all states. " & _
             "'N%' will retrieve all states beginning with 'N'" & vbCr & _
             "'%Y' will retrieve all states ending in 'Y'", _
             "State Code Prompt", "%") _
        )      
If s > "" Then

The Trim statement removes any blanks before or after the user’s input.  The InputBox statement creates the form.  If the user hits cancel, “s” will be empty and we shouldn’t do anything.  If “s” is not empty, we must incorporate it in our SQL string.  Add the red colored text into this existing line (from last post).

"WHERE  O.`Customer ID` = C.ID AND C.`State/Province` LIKE '" & s & "'"

This next bit completes the if statement but it must be just before the End Sub

End If

Congratulations, we just added a little polish to our spreadsheet.


October 10, 2009  11:11 PM

Brain Surgery

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

In the last post we added an “easy” button to “easily” kick off our macro.  Today we’re going to do a little brain surgery on the macro we recorded.  We will:

  • Change the way we clear the worksheet. 
  • Remove properties from the QueryTable statement that aren’t necessary
  • Reformat the QueryTable statement to make its properties clearer
  • Improve the SQL statement’s readability
  • Add the SQL Operator “LIKE” to improve its functionality
  • Add formatting to our results

 Here is the final version:

Sub Macro1()
'   Clear the worksheet
    Cells.Delete
    Cells.ClearContents
   
'   Get Data
    With ActiveSheet.ListObjects.Add( _
            SourceType:=0, _
            Source:=Array( _
                "ODBC;" & _
                "DSN=MS Access Database;" & _
                "DBQ=C:\Users\chatmaker\Documents\Northwind 2007.accdb;"), _
            Destination:=Range("$A$5")).QueryTable
       
        .CommandText = Array( _
            "SELECT O.`Order ID`, O.`Customer ID`, O.`Order Date`, " & _
                   "C.`First Name`" & vbCr & _
            "FROM   Customers C, Orders O " & vbCr, _
            "WHERE  O.`Customer ID` = C.ID AND C.`State/Province` LIKE ?")
        .RowNumbers = False
        .ListObject.DisplayName = "Data"
        .Refresh BackgroundQuery:=False
           
    End With
   
'   Format contents
    ActiveSheet.ListObjects("Data").ListColumns("Order Date"). _
         DataBodyRange.NumberFormat = "m/d/yy"
   
End Sub

Change the way we clear the worksheet
Previously we just cleared the cells’ contents and that was fine until we added a button.   Shapes, like buttons, will sometimes distort (I’m not smart enough to know why – so maybe someone can help me out here) when we clear contents unless we also delete the cells with the QueryTable.  Cells.Delete does the trick. 

Remove properties from the QueryTable statement
When we record macros, XL throws everything into the macro, often far more than is needed.  Compare the code posted here to what XL recorded for you to identify what I’ve cut from our patient.  What we learn from this comparison will help us when we write macros from scratch.

Reformat the QueryTable statement
The macro recorder generates functional code, but it’s not pretty.  I’ve indented pieces to make it a little clearer as to what is what.  The “ActiveSheet.ListObjects.Add” is a very long statement which includes the connection string.  I’ve colored a portion of the connection string in red.  You will need to replace this portion with the location of your NorthWind database.  

Improve the SQL statement’s readability
The SQL string generated by the macro recorder contains the database’s full path and uses the table’s full name as an alias.  The full path is unnecessary because the connection string provides it.  Once we remove the path from the table’s name, using the table’s full name as an alias serves no purpose.  So to make the SQL string easier to read, I’ve used “O” as an alias for the Orders table and “C” for Customers

For more about Aliases see: http://www.w3schools.com/sql/sql_alias.asp

I’ve also replaced the CHR(13) & CHR(10) with a constant provided by VBA, vbCR.  The result is a much cleaner, shorter, easier to read SQL statement that functions identical to the recorded SQL statement except -

Add the SQL Operator “LIKE”
I’ve improved our SQL’s WHERE clause with LIKE.  LIKE lets us use wildcard characters.  So if I want all state codes that begin with “N”, I can enter “N%” (without the quotes) in the parameter to retrieve records for NC, ND, NY, NH, etc.  Or I can retrieve all records by entering “%” by itself.  If I just want records for “NY”, then I still enter “NY”.  So LIKE in a WHERE clause is like “=” only more versatile.

For more information on the LIKE keyword see: http://www.w3schools.com/sql/sql_like.asp
For more information about wildcards used in LIKE see: http://www.w3schools.com/sql/sql_wildcards.asp

Add Formatting
Sometimes XL will represent dates as date serial numbers that mean nothing to us humans.  We can fix that by adding formatting. The “ActiveSheet.ListObjects(1).ListColumns(“Order Date”).DataBodyRange.NumberFormat = “m/d/yy”” statement instructs VBA to apply the number format “m/d/yy” to the cells in the data range of the column with header “Order Date”. 

One of the neat things about ListObjects, such as this, is you can refer to ranges within ListObjects in ways that make sense.  A listObject is also known as a Table.  Tables are always part of a worksheet.  Tables have several ranges all set up for us: header rows, data rows, total rows, and columns.  So to get to one of those ranges, we need to use the ListObject hierarchy: Worksheet Object > ListObjects Collection > Specific ListObject > then one of the following:

HeaderRowRange - Row with all column headers
DataBodyRange - Table’s data (Table without the Headers or Totals)
TotalRowRange - Row with totals (If ShowTotals is set to TRUE)
ListRows(n) - nth row in our table
ListColumns(n or Header) – nth column in our table, or colum with a specific Header

For more information on ListObjects see: http://msdn.microsoft.com/en-us/library/bb242354(v=office.12).aspx

Change your macro to look like the listing above (fixing the red colored code as instructed) and save your spreadsheet.  Click your “easy” button (prior post) and play with different wildcard parameters.  We’ve got a little more UI (User Interface) work to do and then we’ll start adding pivot tables and charts.


October 6, 2009  7:04 PM

Code for “easy” Button

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

Put an “easy” button in your spreadsheets to facilitate launching any macro.

Welcome new readers.  We’ve been talking about how to bring data into XL.  This post introduces the first of many standard routines I use to make assembling real data analysis tools in minutes.  It’s a little function to enhance the user experience by making buttons that look similar to Staple’s “easy” button.  Who couldn’t use an “easy” button?  

easy button

easy button

Option Explicit
Global Const Success = False
Global Const Failure = True 
 
Function Create_Easy_Button(sText As String, sMacro As String, _
                            x As Long, y As Long) As Boolean
'   Create_Easy_Button:     Create a clickable button resembling
'                           Staples' "easy" button
'   Parameters:     sText:  A short word for the button like
'                           "easy", "Load", "Post", "Save", or "New"
'                   sMacro: The macro name to attach to this button
'                   x:      Button's horizontal position
'                   y:      Button's vertical position
'   Example:        Create_Easy_Button "easy", "Macro1", 10, 8
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming Copyright Craig Hatmaker 10/07/2009
    On Error GoTo ErrHandler            '
    Create_Easy_Button = Failure        'Assume the Worst
    If ShapeExists(sText & "_Button_Base") Then _
        ActiveSheet.Shapes(sText & "_Button_Base").Delete
    If ShapeExists(sText & "_Button_Text") Then _
        ActiveSheet.Shapes(sText & "_Button_Text").Delete
    If x = 0 Then x = 10
    If y = 0 Then y = 8
    With ActiveSheet.Shapes.AddShape(msoShapeOval, x, y, 35, 35)
        .Name = sText & "_Button_Base"
        .Fill.ForeColor.RGB = RGB(200, 0, 0)        'Dark Red center
        .Placement = xlFreeFloating
        .OnAction = sMacro
        With .Line 'White border
            .ForeColor.RGB = RGB(255, 255, 255)
            .Weight = 3
        End With
        With .Shadow
            .Visible = True
            .OffsetX = 2
            .OffsetY = 2
            .Transparency = 0.5
            .ForeColor.RGB = RGB(10, 10, 10)
        End With
        With .ThreeD
            .BevelTopType = 3
            .BevelTopDepth = 20  'Rounded top
            .BevelTopInset = 19  'Rounded Top
            .ContourWidth = 0    'No line around the base
            .Depth = 2
            .ExtrusionColorType = 1
            .FieldOfView = 45
            .LightAngle = 300    'Light from above and to the left
            .Perspective = 0
            .PresetLighting = 15
            .PresetMaterial = 6  'Plastic
        End With
    End With
    With ActiveSheet.Shapes.AddTextbox( _
         msoTextOrientationHorizontal, x - 1, y - 2, 35, 35)
        .Name = sText & "_Button_Text"
        With .TextFrame
            .MarginBottom = 0
            .MarginLeft = 0
            .MarginRight = 0
            .MarginTop = 0
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
            .Characters.Text = sText
            With .Characters.Font
                .Bold = True
                .Size = 16
                .Name = "Calibri"
                .Color = RGB(255, 255, 255)
                .Shadow = True
            End With
        End With
        .Line.Visible = False
        .Fill.Visible = False
        .TextEffect.PresetTextEffect = 2
        .Placement = xlFreeFloating
        .OnAction = sMacro
    End With
   
    Create_Easy_Button = Success         'Successful finish
ErrHandler:
    On Error GoTo 0   
    If Err.Number <> 0 Then MsgBox _
        "Create_Easy_Button - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End Function
Function ShapeExists(sName As String)
'   ShapeExists:    See if a Shape Exists
'   Parameters:     sName - Shape Name to be checked
'   Example:        If not ShapeExists("EasyButton") then _
'                       Create_Easy_Button "easy", "Show_Prompt", 10, 8
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    ShapeExists = False     'Assume not found
   
    Dim objName As Object
   
    For Each objName In ActiveSheet.Shapes
        If objName.Name = sName Then
            ShapeExists = True
            Exit For
        End If
    Next
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "ShapeExists - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function


October 6, 2009  7:03 PM

Improving the User Interface – Adding a Button

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker
Adding Buttons

Adding Buttons

So far we’ve extracted data from a database, populated cells in XL, recorded a macro and written a bit of VBA.  Today we address the user interface (UI) by adding something simple like a button.  The button will be used to start our macro.

Until now, we started macros by pressing Alt-F8 to bring up the Macro dialog, select the macro we wanted to run, and then, run it.  Now that’s not too difficult, but it’s more steps than it needs to be.  We can reduce all that to one simple click of the mouse by placing a button on the spreadsheet and associating it with your macro.

To add a button, navigate XL’s menu to Insert > Shapes (or prior to Office 2007 Insert > Picture >AutoShapes) and select any shape you like.  I selected a basic rectangle.  Your cursor will change to a crosshair.  Move the crosshair to the upper left corner of where you’d like your button, then click and drag down and to the right to extend the shape to a desired size.  Format it as you like.  Next, right click on the shape and select the Assign Macro option.  Select Macro 1 and click OK.  Now try out your new button.  If everything went well, you will see the parameter prompt for the state, and after entering that parameter, data will fill your spreadsheet.

Congratulations!  You have literally made pulling data from a database into XL as simple as one click of a mouse.

BONUS!  If the office supply store “Staples” is in your area, then you’ll recognize their “easy” button.   You can add your own “easy” button from code and change the wording to anything you want.  I typically add three buttons to worksheets that update data in the database: “new”, “load”, “post”.  But for spreadsheets that only pull data, I use “easy”.  See “Code for the “easy” Button” next.


October 1, 2009  10:02 AM

Intro to XL Objects in VBA

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

In our last post we looked at running a query that accepts user input to determine the result set loaded into XL.  I want to emphasize that although we used an Access database as our source, these same tools and processes work with Oracle, SQL Server, AS/400/iSeries/IBM i/Power i/System i (however you prefer to call it) databases and many others.  If you need help connecting to your database, post a comment with what you’re trying to connect to and I’ll try to address it or I’ll point you to good resources.

There are lots of opportunities for improvement on that last post including adding summaries, charts, filters, sorts, etc.  The first improvement I’d like to make is to include the clearing of any previous query into Macro 1 and thereby, eliminate one more step.  Using the spreadsheet from before (if you didn’t save it, just recreate it using the prior post’s instructions.  It only takes a few minutes and it’s good practice), edit Macro 1 (use Alt-F11 to bring up the VBE).  Add this line just before the first line of code (but after the Sub Macro1() line):

Cells.ClearContents

This line is equivalent to right clicking the “Select All” box and selecting Clear Contents (If you turned on the Macro Recorder and performed those actions you’d get this line of code in a new subroutine).   If you’re new to VBA, this will probably look strange to you so let me break it down. 

Objects:
VBA manipulates XL’s objects .  One of the most common objects in an XL spreadsheet is a Range.  A Range object can contain one or more cells.  Cells is a special Range object that contains ALL cells in a spreadsheet.  Cells is the XL object in that line of code. 

Methods:
VBA can invoke XL’s object methodsMethods are actions that are predefined and exposed (made available to us) for a given object.  To invoke any of an object’s methods, use the syntax: <Object>.<Method>.  ClearContents is the Cells’ method in that line of code. 

Properties:
VBA can read XL’s object properties.  To read an object’s property into a variable use the syntax: <Variable> = <Object>.<Property>.  Example:  One of the Cells object’s properties is AllowEdit. AllowEdit indicates if the range can be edited on a protected worksheet.  So to read the Cells’ AllowEdit property into variable A, write:

A = Cells.Address

VBA can set some of XL’s object properties.  To set an object’s property use the syntax: <Object>.<Property> = <Value>.  Example: One of the Cells object’s properties is Value. Value is the contents of Cells.  So to set the Cells’ Value property to “A”, write:

Cells.Value = “A”

Include the Cells.ClearContents line in your Macro 1 and then re-run it using Alt-F8 as explained in the prior post and observer the results.  Congratulations, you’ve just reduced the amount of steps needed to retrieve different results.


Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to: