Extending Excel OLAP Functionality
This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.
Michael Stowe
Microsoft Corporation
May 2002
Applies to:
Microsoft® Excel 2002
Microsoft SQL Server™ 2000 Analysis Services
Summary: How to extend Excel OLAP functionality to obtain detailed records for an aggregate value, update an OLAP cube with a new aggregate, and retrieve one or more aggregates from an OLAP cube into a worksheet without creating a PivotTable. (22 printed pages)
Download Xlextendolap.exe.
Contents
Introduction
Drilling Through to the Details
Performing "What If?" Analysis with PivotTable Data
OLAP Unbound!
Conclusion
Introduction
Microsoft® Excel provides you with the ability to use Microsoft PivotTables® to summarize data stored in online analytical processing (OLAP) cubes. This article describes how you can extend Excel OLAP functionality to obtain detailed records for an aggregate value, update an OLAP cube with a new aggregate, and retrieve one or more aggregates from an OLAP cube into a worksheet without creating a PivotTable.
System Requirements
The examples presented in this article require the following software to be installed on a single computer:
- Microsoft Excel 2002.
- Microsoft SQL Server™ 2000 Analysis Services with the sample FoodMart 2000 database. Each example specifies localhost as the Analysis server.
- The Extending OLAP.xls spreadsheet contained in the odc_xlextendolap.exe download mentioned at the beginning of this article.
- The Drilling Through to the Details example requires that drillthough is enabled on the Sales cube in the FoodMart 2000 database. To enable drillthrough, see the Help topic "Specifying Drillthrough Options" in SQL Server Books Online provided with your Analysis server.
- The Performing "What If?" Analysis With PivotTable Data example requires that Writeback is enabled on the Warehouse cube in the FoodMart 2000 database. To enable writeback, see the Help topic "Write-Enabling a Cube" in SQL Server Books Online provided with your Analysis server.
- The OLAP Unbound example requires the OLAP CubeCellValue Add-in. See Excel 2002 Add-in: OLAP CubeCellValue for more information about this Add-in.
Drilling Through to the Details
The OLAP cubes that make up data warehouses contain aggregations of large amounts of multidimensional data. There may be times when you want to view the detail records that contribute to an aggregate value displayed in your PivotTable. Microsoft SQL Server 2000 Analysis Services introduced a feature called drillthrough, which allows you to "drill through" an aggregate to reveal the underlying detail records.
The Excel 2002 object model does not provide native support for performing drillthrough operations. The following example illustrates how to perform drillthrough operations by using the Microsoft ActiveX® Data Objects Multidimensional (ADOMD) type library.
In this example, a menu command titled OLAP Drillthough is added to the PivotTable context menu. When the user selects the menu item while in the data area of an OLAP PivotTable, the appropriate drillthrough query is submitted to Analysis Services and the detail records are written into a new worksheet. To try this out, right-click a data cell on the Drillthrough worksheet in the Extending OLAP.xls sample workbook and then click OLAP Drillthrough.
The menu item is created in the Workbook_Open event.
Private Sub Workbook_Open()
Dim ptcon As CommandBar
Dim cmdDrill As CommandBarControl
Set ptcon = Application.CommandBars("PivotTable context menu")
For Each btn In ptcon.Controls
' Exit the procedure if the mnue item already exists.
If btn.Caption = "OLAP Drillthrough" Then GoTo noadd
Next btn
' Add an item to the PivotTable context menu.
Set cmdDrill = ptcon.Controls.Add( _
Type:=msoControlButton, temporary:=True)
' Set the properties of the menu item.
cmdDrill.Caption = "OLAP Drillthrough"
cmdDrill.OnAction = "Drillthrough"
noadd:
End Sub
Clicking the OLAP Drillthrough item invokes the Drillthrough procedure.
Sub Drillthrough()
Dim Cat As ADOMD.Catalog
Dim Conn As ADODB.Connection
Dim qry As String
Dim pcell As PivotCell
Dim pt As PivotTable
Dim i As Integer
Dim rs As ADODB.Recordset
Dim iAxisNum As Integer
Dim sDrillQry As String
' Set a variable to the PicotCell object of the active cell.
Set pcell = ActiveCell.PivotCell
' If the cell isn't part of an OLAP PivotTable, then call
' the errmsg error handler.
If Not (pcell.PivotTable.PivotCache.OLAP) Then GoTo errmsg
' If the cell isn't in the data area of the PivotTable, then
' call the errmsg error handler.
If pcell.PivotCellType <> xlPivotCellValue Then GoTo errmsg
Set pt = pcell.PivotTable
' Make sure that the PivotTable's cache is connected
' to the data source.
If Not pt.PivotCache.IsConnected Then
pt.PivotCache.MakeConnection
End If
The first portion of the Drillthrough procedure allocates the variables to be used in the procedure, then performs some basic error checking. First, a variable is set to the PivotCell object that represents the active cell in the PivotTable report. Then, a couple of If statements are used to determine whether or not the PivotTable report is connected to an OLAP data source, and whether or not the active cell is in the data area of the PivotTable report. If either of these statements are False, then an error handler named errmsg is called. Finally, the PivotTable report's cache is connected to the data source.
' Create a new Catalog.
Set Cat = New ADOMD.Catalog
' Create a new connection.
Set Conn = New ADODB.Connection
' Set up the ADOMD catalog.
Set Cat.ActiveConnection = pt.PivotCache.ADOConnection
' Set up the ADO connection.
Set Conn = pt.PivotCache.ADOConnection
This section creates an ADO Connection object and an ADOMD Catalog object, then connects both objects to PivotTable report's cache (PivotCache).
sDrillQry = "Drillthrough maxrows 2500 Select "
The sDrillQry variable is used to store the Multidimensional Expression (MDX) query that will be used to retrieve the detail records. This is the leftmost portion of the string, which will be appended to later in this procedure.
' Loop through row items. The outermost items will be added to
' the MDX statement.
For i = 1 To pcell.RowItems.Count – 1
If pcell.RowItems(i).Parent.CubeField.Name <> _
pcell.RowItems(i + 1).Parent.CubeField.Name Then
' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' Increment the axis dimension.
iAxisNum = iAxisNum + 1
End If
Next i
' Add the innermost row item if more than one item has been added
' to the row axis.
If pcell.RowItems.Count > 0 Then
' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' Increment the axis dimension.
iAxisNum = iAxisNum + 1
End If
This section of the procedure builds the portion of the MDX query representing the fields displayed on the row axis of the PivotTable report.
' Loop through row items. The outermost items will be added to
' the MDX statement.
For i = 1 To pcell.ColumnItems.Count - 1
If pcell.ColumnItems(i).Parent.CubeField.Name <> _
pcell.ColumnItems(i + 1).Parent.CubeField.Name Then
' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' Increment the axis dimension.
iAxisNum = iAxisNum + 1
End If
Next i
' Add the innermost column item if more than one item has been
added
' to the column axis.
If pcell.ColumnItems.Count > 0 Then
' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.ColumnItems(i) _
& "} on " & iAxisNum & ", "
' Increment the axis dimension.
iAxisNum = iAxisNum + 1
End If
This section of the procedure builds the portion of the MDX query representing the fields displayed on the column axis of the PivotTable report.
' Loop through the visible page items.
For i = 1 To pt.PageFields.Count
' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pt.PageFields(i).CurrentPageName
_
& "} on " & iAxisNum & ", "
' Increment the axis dimension.
iAxisNum = iAxisNum + 1
Next I
This section of the procedure builds the portion of the MDX query representing the fields displayed on the page axis of the PivotTable report.
' Remove the trailing ", ".
sDrillQry = Left$(sDrillQry, Len(sDrillQry) - 2)
' Add the cube name to the MDX statement.
sDrillQry = sDrillQry & " From " & "[" & _
pt.PivotCache.CommandText & "]"
' Create a new recordset
Set rs = New ADODB.Recordset
On Error GoTo errmsg
With rs
' Pass the MDX atatement to the recordset.
.Source = sDrillQry
Set .ActiveConnection = Conn
' Open the recordset.
.Open
End With
In this section the MDX statement is finalized, then specified as the source data for a new ADO Recordset object.
On Error GoTo 0
' Add a new worksheet.
Set ws = Worksheets.Add
' Add a QueryTable to the worksheet. Connect the query table to
' the recordset that contains the results of the MDX statement.
With ws.QueryTables.Add(Connection:=rs,
Destination:=ws.Range("A1"))
.Refresh
End With
Exit Sub
errmsg:
MsgBox "Cannot Drillthrough on this selection."
End Sub
The final section of this procedure adds a new worksheet to the workbook. Then, the results of the MDX statement are returned to the worksheet through a QueryTable object.
Performing "What If?" Analysis with PivotTable Data
Have you ever wanted to perform a "what-if" analysis with a PivotTable? SQL Server Analysis Services includes a feature called writeback, which allows client applications to record changes to an OLAP cube's data.
Excel 2002 does not provide native support for performing writeback operations. The following example illustrated how you can use an Excel event to capture changes made to a PivotTable, and then build and submit the appropriate MDX statement to Analysis Services for processing. To try this out, type a value into a blank data cell on the Writeback worksheet of the Extending OLAP.xls sample workbook, and then press ENTER.
Changes to the PivotTable are captured by the Worksheet_Change event for the worksheet that contains the PivotTable.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As PivotCell
' Err.Number return 0 when this event is called from
' the worksheet, and a different value when Undo is
' invoked in the Writeback procedure
If Err.Number <> 0 Then GoTo done
' This event is called again by the Writeback procedure.
' This exits that call, as well as others that do not matter.
If TypeName(Target.Value) <> "Double" Then GoTo done
On Error GoTo done
' Set a PivotCell object. If the change wasn't in a PivotTable,
' Then the done error handler is invoked.
Set cell = Target.PivotCell
On Error GoTo 0
' If PivotTable cell change was in data area, then process it
' as a writeback operation.
If cell.PivotCellType = xlPivotCellValue Then
Call Writeback(cell, Target.Value)
End If
done:
On Error GoTo 0
End Sub
This procedure ensures that the change was made to a value in the data area of a PivotTable. When this condition has been satisfied, then the Writeback procedure is called. A PivotCell object representing the changed aggregate and the new aggregate value are passed to the Writeback procedure.
Sub Writeback(pcell As PivotCell, newval As Double)
Dim adoCmd As ADODB.Command
Dim Conn As ADODB.Connection
Dim pt As PivotTable
Dim pcache As PivotCache
Dim pf As PivotField
Dim pitmlist(1 to 2) As PivotItemList
Dim cmdtxt As String
Dim itmtxt As String
Dim oldcf As String
Dim cubnam As String
Dim i As Integer
Dim k As Integer
' The majority of the processing time will take
' place outside of Excel, so it's a good idea to
' indicate the staus of the update.
Application.Cursor = xlWait
' Set up variables representing the PivotTable
' and the PivotTable's cache.
Set pt = pcell.Parent
Set pcache = pt.PivotCache
' Make sure that the PivotTable's cache is connected
' to the data source.
If Not pcache.IsConnected Then
pcache.MakeConnection
End If
' Create a new ADO Command object.
Set adoCmd = New ADODB.Command
' Create a new ADO recordset.
Set Conn = New ADODB.Connection
' Set the session command object and then get a handle to
' the connection object.
Set adoCmd.ActiveConnection = pcache.ADOConnection
Set Conn = adoCmd.ActiveConnection
The first portion of the Writeback procedure allocates the variables to be used in the procedure makes the connections necessary to send changed aggregations to Analysis Services. The PivotCell object passed into the procedure is the key to setting up the necessary PivotTable, PivotCache, ADO Command, and ADO Connection objects.
' The cmdtxt variable stores the command to send to
' Analysis Services to perform allocation.
cmdtxt = ""
cmdtxt = cmdtxt & pcell.DataField.Name & ","
' Add each page field to the cmdtxt variable.
If pt.PageFields.Count > 0 Then
For Each pf In pt.PageFields
cmdtxt = cmdtxt & pf.CurrentPageName & ","
Next pf
End If
The first two lines of code in this section initialize a String variable (cmdtxt) that will store the MDX statement that will be sent to Analysis Services. The For. . .Each loop adds any page fields to the cmdtxt variable.
Set pitmlist(1) = pcell.RowItems
Set pitmlist(2) = pcell.ColumnItems
For k = 1 To 2
'Add row fields to cmdtxt, if any in view
If pitmlist(k).Count > 0 Then
' The itmtxt variable is temporary text holder.
' Only add lowest level of each dimension in view to cmdtxt
itmtxt = ""
oldcf = pitmlist(k)(1).Parent.CubeField.Name
' This loop only adds to cmdtxt when CubeField changes.
For i = 1 To pitmlist(k).Count
If pitmlist(k)(i).Parent.CubeField.Name = oldcf Then
itmtxt = pitmlist(k)(i)
Else
cmdtxt = cmdtxt & itmtxt & ","
oldcf = pitmlist(k)(i).Parent.CubeField.Name
itmtxt = pitmlist(k)(i)
End If
Next i
' Last row item is always lowest level and so added to
cmdtxt.
itmtxt = pitmlist(k)(pitmlist(k).Count)
cmdtxt = cmdtxt & itmtxt & ","
End If
Next k
This section adds the appropriate row and column items to the cmdtxt variable. The pitmlist variable is an array of PivotItem objects. The first item in the array is the collection of RowItem objects. The second item in the array is the collection of ColumnItem objects.
cubnam = "[" & pcache.CommandText & "]"
' Create the final command to send to Analysis Server.
' The new aggregate will be divided evenly among each
' contributing cell.
cmdtxt = "Update cube " & cubnam & " set (" & _
Left(cmdtxt, Len(cmdtxt) - 1) & ")=" & _
newval & " Use_Equal_allocation"
' Pass the MDX statement to the Command object, then execute
' execute the update
With adoCmd
.CommandText = cmdtxt
.Execute
End With
On Error GoTo writefailed
' Open a new Transaction object, then
' commit the change.
With Conn
.Attributes = adXactCommitRetaining
.CommitTrans
End With
' Refresh the PivotTable to see effect of the
' allocation in the view.
pcache.Refresh
GoTo cleanup
This section of code assembles the final MDX statement, and then sends the updated aggregate through the ADO Command object to the Analysis Server. Finally, the update is committed and the PivotTable is refreshed to update the subtotals.
writefailed:
Select Case Err.Number
' Alert for a timeout error.
Case -2147168234
MsgBox "Writeback failed due to a timeout."
' Alert for a read-only error.
Case -2147168254
MsgBox "Writeback failed because the OLAP cube " & _
"is not write-enabled."
Case Else
' Alert for any other error.
MsgBox "Cannot commit the updated value to Analysis
Server."
End Select
' Undo the edit.
Application.Undo
GoTo cleanup
' Clean up the ADO variables and the mouse cursor cleanup:
Set Cmd = Nothing
Set Conn = Nothing
Application.Cursor = xlDefault
End Sub
The final section of code contains an error handler which displays an error messages uses the Undo method to roll back the value of the changed cell.
OLAP Unbound!
You must use a PivotTable to analyze data stored in an OLAP cube in Excel. The previous sentence was a true statement until the OLAP CubeCellValue Add-in was posted to the Microsoft Office Tools on the Web site after Excel 2002 was released.
The OLAP CubeCellValue Add-in allows you retrieve a single aggregate value from and OLAP cube directly into a cell. The add-in utilizes the CubeCellValue function used to retrieve an aggregate value from an OLAP cube. You can use a dialog box to connect to specify the parameter for the function, or you can type the function directly into a cell. The following example illustrates one approach to retrieving aggregate values from an OLAP cube by typing member names directly into your worksheet. To try this out, type Food in cell C5, type Q1 in cell D4 of the Free Range OLAP worksheet of the Extending OLAP.xls sample workbook, and then press ENTER.
This example utilizes two "hot" zones that accept member names. When a user changes a value on the worksheet, the Worksheet_Change event is used to determine whether the change was in one of the hot ranges. If the user entered a value in one of the hot ranges, then the FreeRangeOLAP procedure is called. This procedure analyzes the hot ranges and then builds the appropriate CubeCellValue formula.
When using this example, please note that the OLAP CubeCellValue Add-in does not allow you to specify more than one member form the same dimension.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngHotRows As Range
Dim rngHotCols As Range
Dim rngData As Range
Dim rngRowTest As Range
Dim rngColTest As Range
' Exit the procedure if the cell has been cleared.
If IsEmpty(Target.Value) Then GoTo done
' Exit the procedure if the changed region consists
' of more than one cell.
If IsArray(Target.Value) Then GoTo done
' Exit the procedure if it is being called as
' a result of writing a CubeCellValue formula.
If Left(Target.Formula, 14) = "=CubeCellValue" Then GoTo done
The first section of the Worksheet_Change procedure declares several variables, and then asks several questions about the changed cell region.
' Set up variables to represent the input area
' and the upper-left corner of the formula range.
Set rngHotRows = Range("B5:C10")
Set rngHotCols = Range("D3:H4")
Set rngData = Range("D5")
' Set variables to the intersection of the changed cell
' and the hot cell ranges.
Set rngRowTest = Application.Intersect(Target, rngHotRows)
Set rngColTest = Application.Intersect(Target, rngHotCols)
' Check to see whether the changed cell resides in either of
' the hot cell ranges. If so, call the FreeRangeOLAP procedure.
If (Not rngRowTest Is Nothing) Or (Not rngColTest Is Nothing) Then
Call FreeRangeOLAP(rngHotRows, rngHotCols, rngData)
End If
done:
End Sub
This code establishes the hot cell ranges, and then checks whether or not the changed cell falls within those ranges. The FreeRangeOLAP procedure is called if the changed cell is within a hot cell range.
Sub FreeRangeOLAP(ByVal rngHotRows, ByVal rngHotCols, ByVal rngData)
Dim cell As Range
Dim sCubeFormula As String
Dim i As Integer
' Loop through the "hot" rows.
For Each cell In rngHotRows
' Check for a value in the cell.
If cell.Value <> "" Then
i = 1
' Initialize the formula string.
sCubeFormula = "=CubeCellValue" & _
"(""localhost FoodMart 2000 Sales"","
' Add the value of the current cell to the formula.
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Value) & Chr$(34) & ","
' Add to the formula if both columns B and C contain
values.
If cell.Column = 2 And cell.Offset(0, 1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, 1) _
.Value) & Chr$(34) & ","
End If
' Add to the formula if both columns B and C contain
values.
If cell.Column = 3 And cell.Offset(0, -1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, -1) _
.Value) & Chr$(34) & ","
End If
' Add to the formula if a value has been entered into
' the top row of the column area.
If Range("a1").Cells(3, rngData.Offset(cell.Row - 5, i - 1)
_
.Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(3, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & Chr$(34) & ","
End If
' Add to the formula if a value has been entered
' into the second row of the column area.
If Range("a1").Cells(4, rngData.Offset(cell.Row - 5, i - 1)
_
.Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(4, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & Chr$(34) & ","
End If
' Add a closing parenthesis mark to the CubeCellValue
formula.
sCubeFormula = Left(sCubeFormula, Len(sCubeFormula) - 1) &
")"
' Write a CubeCellValue formula to the worksheet.
rngData.Offset(cell.Row - 5, i - 1).FormulaR1C1 =
sCubeFormula
This section of the FreeRangeOLAP procedure begins looping through each cell in the hot row area (B5:C10). When a value is found, then a variable representing the eventual CubeCellValue formula (sCubeFormula
) is initialized. The cell value is then concatenated into thesCubeFormula
string.
The code then checks various combinations of cells in the hot row area (B5:C10) and the cells in first hot column (D3:D4). The appropriate values are added to thesCubeFormula
string.
The BracketIt function is called each time a new value is added to thesCubeFormula
string. This function simply adds a closing bracket to the cell value.
Finally, a CubeCellValue formula is written to the appropriate cell.
' Loop through the last four "hot" columns.
For i = 2 To rngHotCols.Columns.Count
' Add to the formula if either row of the "hot"
' cells in the column input area contain values.
If rngHotCols.Cells(1, 1).Offset(0, i - 1).Value <> ""
Or _
rngHotCols.Cells(1, 1).Offset(1, i - 1).Value
<> "" Then
' Reinitialize the formula string.
sCubeFormula = "=CubeCellValue" & _
"(""localhost FoodMart 2000 Sales"","
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Value) & Chr$(34) & ","
' Add to the formula if both columns B and C
' contain values.
If cell.Column = 2 And _
cell.Offset(0, 1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, 1) _
.Value) & Chr$(34) & ","
End If
' Add to the formula if both columns B and C
' contain values.
If cell.Column = 3 And _
cell.Offset(0, -1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, -1) _
.Value) & Chr$(34) & ","
End If
' Add to the formula if a value has been entered
' into the top row of the column area.
If Range("a1").Cells(3, rngData.Offset(cell.Row –
5, _
i - 1).Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(3, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & _
Chr$(34) & ","
End If
' Add to the formula if a value has been entered
' into the second row of the column area.
If Range("a1").Cells(4, rngData.Offset(cell.Row –
5, _
i - 1).Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(4, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & _
Chr$(34) & ","
End If
' Add a closing parenthesis mark to the
' CubeCellValue formula.
sCubeFormula = Left(sCubeFormula, _
Len(sCubeFormula) - 1) & ")"
' Write a CubeCellValue formula to the worksheet.
rngData.Offset(cell.Row - 5, i - 1) _
.FormulaR1C1 = sCubeFormula
End If
Next I
This section loops through the remainder of the cells in the remainder of the hot columns (E3:H4). Various combinations of cells are checked for values. When a value is found, thesCubeFormula
is updated. Then, a CubeCellValue formula is written to the appropriate cell.
End If
Next cell
Finally, the opening If statement is closed and the code moves to the next cell in the how row area.
End Sub
Function BracketIt(ByVal sCubeFormula As String) As String
' Add a closing bracket if the first character
' if the string is an opening bracket
If Left(sCubeFormula, 1) <> "[" Then
sCubeFormula = "[" & sCubeFormula & "]"
End If
BracketIt = sCubeFormula
End Function
Conclusion
Although Excel PivotTables don't directly support advanced Analysis Service features such as writeback and drillthrough, you can seamlessly integrate these features into Excel. Additionally, you can make use of the OLAP CubeCellValue Add-in programmatically to create dynamic OLAP-based solutions without using a PivotTable.