February 6, 2010
This is a somewhat complicated example that builds a couple of sample tables, uses a SQL statement with the Oracle analytic function LEAD submitted through ADO in an Excel macro, and then presents the information on an Excel worksheet. When the user clicks one of three buttons on the Excel worksheet, an Excel macro executes that then build charts using disconnected row sources – a disconnected ADO recordset is used to sort the data categories before pushing that data into the charts that are built on the fly.
To start, we need to build the sample tables. The first two tables follow, a part list table and a vendor list table with random data:
CREATE TABLE PART_LIST (
PART_ID VARCHAR2(30),
PRODUCT_CODE VARCHAR2(30),
COMMODITY_CODE VARCHAR2(30),
PURCHASED CHAR(1),
PRIMARY KEY (PART_ID));
INSERT INTO
PART_LIST
SELECT
DBMS_RANDOM.STRING('Z',10),
DBMS_RANDOM.STRING('Z',1),
DBMS_RANDOM.STRING('Z',1),
DECODE(ROUND(DBMS_RANDOM.VALUE(1,2)),1,'Y','N')
FROM
DUAL
CONNECT BY
LEVEL<=50000;
COMMIT;
CREATE TABLE VENDOR_LIST (
VENDOR_ID VARCHAR2(30),
PRIMARY KEY (VENDOR_ID));
INSERT INTO
VENDOR_LIST
SELECT
DBMS_RANDOM.STRING('Z',10)
FROM
DUAL
CONNECT BY
LEVEL<=100;
COMMIT;
Next, we need to build a purchase transaction history table, allowing a single part to be purchased from 10 randomly selected vendors of the 100 vendors. This is actually a Cartesian join, but we need to force it to handled as a nested loop join so that we will have a different set of 10 vendors for each PART_ID:
CREATE TABLE PURCHASE_HISTORY ( TRANSACTION_ID NUMBER, VENDOR_ID VARCHAR2(30), PART_ID VARCHAR2(30), UNIT_PRICE NUMBER(12,2), PURCHASE_DATE DATE, PRIMARY KEY (TRANSACTION_ID)); INSERT INTO PURCHASE_HISTORY SELECT /*+ ORDERED USE_NL(PL VL) */ ROWNUM, VL.VENDOR_ID, PL.PART_ID, VL.UNIT_PRICE, VL.PURCHASE_DATE FROM PART_LIST PL, (SELECT 'A' MIN_PART, 'ZZZZZZZZZZZ' MAX_PART, VENDOR_ID, UNIT_PRICE, PURCHASE_DATE, ROWNUM RN FROM (SELECT VENDOR_ID, ROUND(DBMS_RANDOM.VALUE(0,10000),2) UNIT_PRICE, TRUNC(SYSDATE) - ROUND(DBMS_RANDOM.VALUE(0,5000)) PURCHASE_DATE FROM VENDOR_LIST ORDER BY DBMS_RANDOM.VALUE)) VL WHERE PL.PURCHASED='Y' AND VL.RN<=10 AND PL.PART_ID BETWEEN VL.MIN_PART AND VL.MAX_PART; COMMIT;
Before we start working in Excel, we need to put together a SQL statement so that we are able to determine by how much the price of a part fluctuates over time. We will use the LEAD analytic function to allow us to compare the current row values with the next row values, and only output the row when either the VENDOR_ID changes or the UNIT_PRICE changes. While the sample data potentially includes dates up to 5,000 days ago, we only want to consider dates up to 720 days ago for this example:
SELECT /*+ ORDERED */ PH.PART_ID, PH.VENDOR_ID, PH.UNIT_PRICE, PH.LAST_VENDOR_ID, PH.LAST_UNIT_PRICE, PL.PRODUCT_CODE, PL.COMMODITY_CODE FROM (SELECT PH.PART_ID, PH.VENDOR_ID, PH.UNIT_PRICE, PH.PURCHASE_DATE, LEAD(PH.VENDOR_ID,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_VENDOR_ID, LEAD(PH.UNIT_PRICE,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_UNIT_PRICE FROM PURCHASE_HISTORY PH WHERE PH.PURCHASE_DATE>=TRUNC(SYSDATE-720)) PH, PART_LIST PL WHERE PH.PART_ID=PL.PART_ID AND (PH.VENDOR_ID<>NVL(PH.LAST_VENDOR_ID,'-') OR PH.UNIT_PRICE<>NVL(PH.LAST_UNIT_PRICE,-1)) ORDER BY PH.PART_ID, PH.PURCHASE_DATE DESC;
The output of the above SQL statement might look something like this:
PART_ID VENDOR_ID UNIT_PRICE LAST_VENDO LAST_UNIT_PRICE P C ---------- ---------- ---------- ---------- --------------- - - AAAFWXDGOR HHJAWQCYIV 1773.67 RPKWXSTFDS 5841.37 I T AAAFWXDGOR RPKWXSTFDS 5841.37 I T AABDVNQJBS BBOSDBKYBR 4034.07 D J AABNDOOTTV HQBZXICKQM 2932.36 C G AABPRKFTLG NKYJQJXGJN 242.18 HHJAWQCYIV 1997.01 F I AABPRKFTLG HHJAWQCYIV 1997.01 F I AACHFXHCDC SZWNZCRUWZ 3562.43 P G AACNAAOZWE JEYKZFIKJU 4290.12 L N AAEAYOLWMN DNDYVXUZVZ 4431.63 K T AAFLKRJTCO QPXIDOEDTI 8613.52 Q G AAGDNYXQGW BZFMNYJVBP 911.06 RPKWXSTFDS 2813.39 B L AAGDNYXQGW RPKWXSTFDS 2813.39 B L AAGMKTQITK RAGVQSBHKW 9221.90 BCIRRDLHAN 8541.34 S W AAGMKTQITK BCIRRDLHAN 8541.34 CWQNPITMBE 5611.73 S W AAGMKTQITK CWQNPITMBE 5611.73 S W AAINVDSSWC CQXRSIWOIL 2690.31 BBOSDBKYBR 1707.15 K R AAINVDSSWC BBOSDBKYBR 1707.15 QFPGRYTYUM 9158.98 K R AAINVDSSWC QFPGRYTYUM 9158.98 K R AALCTODILL NKYJQJXGJN 2116.94 K M AAMAUJIWLF LPMSAUJGHR 6294.19 CNHZFDEWIH 4666.58 L P AAMAUJIWLF CNHZFDEWIH 4666.58 SZWNZCRUWZ 2096.59 L P AAMAUJIWLF SZWNZCRUWZ 2096.59 L P AAMYBVKFQC GLVKOCSHSF 265.63 PNGVEEYGKA 5869.67 X Z AAMYBVKFQC PNGVEEYGKA 5869.67 X Z AANVGRNFEX NFHOKCKLDN 3961.42 Q O ...
Now we need to switch over to Excel. Create four ActiveX command buttons named cmdInitialize, cmdComparePC, cmdCompareCC, cmdCompareVendorID. Name the worksheet OracleAnalyticTest, as shown below:
Right-click the OracleAnalyticTest worksheet and select View Code. See this blog article to determine how to enable macros in Excel 2007 (if you have not already turned on this feature) and add a reference to the Microsoft ActiveX Data Objects 2.8 (or 6.0) Library. We will also need to add a reference to the Microsoft ActiveX Data Objects Recordset 2.8 (or 6.0) Library. Next, we add the code to the cmdInitialize button:
Option Explicit 'Forces all variables to be declared
Dim dbDatabase As New ADODB.Connection
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String
Private Function ConnectDatabase() As Integer
Dim intResult As Integer
On Error Resume Next
If dbDatabase.State <> 1 Then
'Connection to the database if closed, specify the database name, a username, and password
strDatabase = "MyDB"
strUserName = "MyUser"
strPassword = "MyPassword"
'Connect to the database
'Oracle connection string
dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"
dbDatabase.ConnectionTimeout = 40
dbDatabase.CursorLocation = adUseClient
dbDatabase.Open
If (dbDatabase.State <> 1) Or (Err <> 0) Then
intResult = MsgBox("Could not connect to the database. Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo")
ConnectDatabase = False
Else
ConnectDatabase = True
End If
Else
ConnectDatabase = True
End If
End Function
Private Sub cmdInitialize_Click()
Dim i As Integer
Dim intResult As Integer
Dim lngRow As Long
Dim strSQL As String
Dim snpData As ADODB.Recordset
On Error Resume Next
Sheets("OracleAnalyticTest").ChartObjects.Delete
Sheets("OracleAnalyticTest").Rows("4:10000").Delete Shift:=xlUp
intResult = ConnectDatabase
If intResult = True Then
Set snpData = New ADODB.Recordset
strSQL = "SELECT /*+ ORDERED */" & vbCrLf
strSQL = strSQL & " PH.PART_ID," & vbCrLf
strSQL = strSQL & " PH.VENDOR_ID," & vbCrLf
strSQL = strSQL & " PH.UNIT_PRICE," & vbCrLf
strSQL = strSQL & " PH.LAST_VENDOR_ID," & vbCrLf
strSQL = strSQL & " PH.LAST_UNIT_PRICE," & vbCrLf
strSQL = strSQL & " PL.PRODUCT_CODE," & vbCrLf
strSQL = strSQL & " PL.COMMODITY_CODE" & vbCrLf
strSQL = strSQL & "FROM" & vbCrLf
strSQL = strSQL & " (SELECT" & vbCrLf
strSQL = strSQL & " PH.PART_ID," & vbCrLf
strSQL = strSQL & " PH.VENDOR_ID," & vbCrLf
strSQL = strSQL & " PH.UNIT_PRICE," & vbCrLf
strSQL = strSQL & " PH.PURCHASE_DATE," & vbCrLf
strSQL = strSQL & " LEAD(PH.VENDOR_ID,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_VENDOR_ID," & vbCrLf
strSQL = strSQL & " LEAD(PH.UNIT_PRICE,1,NULL) OVER (PARTITION BY PART_ID ORDER BY PURCHASE_DATE DESC) LAST_UNIT_PRICE" & vbCrLf
strSQL = strSQL & " FROM" & vbCrLf
strSQL = strSQL & " PURCHASE_HISTORY PH" & vbCrLf
strSQL = strSQL & " WHERE" & vbCrLf
strSQL = strSQL & " PH.PURCHASE_DATE>=TRUNC(SYSDATE-270)) PH," & vbCrLf
strSQL = strSQL & " PART_LIST PL" & vbCrLf
strSQL = strSQL & "WHERE" & vbCrLf
strSQL = strSQL & " PH.PART_ID=PL.PART_ID" & vbCrLf
strSQL = strSQL & " AND (PH.VENDOR_ID<>NVL(PH.LAST_VENDOR_ID,'-')" & vbCrLf
strSQL = strSQL & " OR PH.UNIT_PRICE<>NVL(PH.LAST_UNIT_PRICE,-1))" & vbCrLf
strSQL = strSQL & "ORDER BY" & vbCrLf
strSQL = strSQL & " PH.PART_ID," & vbCrLf
strSQL = strSQL & " PH.PURCHASE_DATE DESC"
snpData.Open strSQL, dbDatabase
If snpData.State = 1 Then
Application.ScreenUpdating = False
For i = 0 To snpData.Fields.Count - 1
ActiveSheet.Cells(3, i + 1).Value = snpData.Fields(i).Name
Next i
ActiveSheet.Range(ActiveSheet.Cells(3, 1), ActiveSheet.Cells(3, snpData.Fields.Count)).Font.Bold = True
ActiveSheet.Range("A4").CopyFromRecordset snpData
'Auto-fit up to 26 columns
ActiveSheet.Columns("A:" & Chr(64 + snpData.Fields.Count)).AutoFit
ActiveSheet.Range("A4").Select
ActiveWindow.FreezePanes = True
'Remove duplicate rows with the same PART ID
lngRow = 4
Do While lngRow < Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2
If Sheets("OracleAnalyticTest").Cells(lngRow, 1).FormulaR1C1 = "" Then
'Past the end of the rows
Exit Do
End If
If Sheets("OracleAnalyticTest").Cells(lngRow - 1, 1).FormulaR1C1 = Sheets("OracleAnalyticTest").Cells(lngRow, 1).FormulaR1C1 Then
'Found a duplicate row, delete it
Sheets("OracleAnalyticTest").Rows(lngRow).Delete Shift:=xlUp
Else
lngRow = lngRow + 1
End If
Loop
snpData.Close
Application.ScreenUpdating = True
End If
End If
Set snpData = Nothing
End Sub
The cmdInitialize_Click subroutine retrieves the data from the database using the supplied SQL statement and writes that information to the worksheet. The macro then eliminates subsequent rows if the part ID is identical to the previous part ID (this step would not have been required if we modified the SQL statement to use the ROW_NUMBER analytic function, and eliminate all rows where the ROW_NUMBER value is not 1). Once you add the above code, you should be able to switch back to the Excel worksheet, turn off Design Mode, and click the Initialize button.
Unfortunately, this example will retrieve too many rows with too little variation in the PRODUCT_CODE and COMMODITY_CODE columns (just 26 distinct values), so it might be a good idea to delete all rows below row 1004. Now we need to switch back to the Microsoft Visual Basic editor and add the code for the other three buttons. Note that this code takes advantage of gradient shading in Excel 2007 charts, so some modification might be necessary on Excel 2003 and earlier.
Private Sub cmdCompareCC_Click()
Dim i As Long
Dim intCount As Integer
Dim intChartNumber As Integer
Dim lngRows As Long
Dim dblValues() As Double
Dim strValueNames() As String
Dim snpDataList As ADOR.Recordset
On Error Resume Next
Sheets("OracleAnalyticTest").ChartObjects.Delete
Sheets("OracleAnalyticTest").Cells(4, 1).Select
lngRows = Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2
'Set up to use ADOR to automatically sort the product codes
Set snpDataList = New ADOR.Recordset
snpDataList.Fields.Append "commodity_code", adVarChar, 30
snpDataList.Open
'Pick up a distinct list of commodity codes
For i = 4 To lngRows
'Only include those commodity codes with price changes
If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
If snpDataList.RecordCount > 0 Then
snpDataList.MoveFirst
End If
snpDataList.Find ("commodity_code = '" & Sheets("OracleAnalyticTest").Cells(i, 7) & "'")
If snpDataList.EOF Then
'Did not find a matching record
snpDataList.AddNew
snpDataList("commodity_code") = Sheets("OracleAnalyticTest").Cells(i, 7).Value
snpDataList.Update
End If
End If
Next i
snpDataList.Sort = "commodity_code"
'Find the matching rows for each product code
snpDataList.MoveFirst
Do While Not snpDataList.EOF
intCount = 0
ReDim dblValues(250)
ReDim strValueNames(250)
For i = 4 To lngRows
If intCount >= 250 Then
'Excel charts only permit about 250 data points when created with this method
Exit For
End If
If Sheets("OracleAnalyticTest").Cells(i, 7).Value = snpDataList("commodity_code") Then
'Found a row with this product code
If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
'Price change was found
dblValues(intCount) = Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2)
strValueNames(intCount) = Sheets("OracleAnalyticTest").Cells(i, 1).FormulaR1C1
intCount = intCount + 1
End If
End If
Next i
'Set the arrays to the exact number of elements, first element at position 0
ReDim Preserve dblValues(intCount - 1)
ReDim Preserve strValueNames(intCount - 1)
intChartNumber = intChartNumber + 1
With Sheets("OracleAnalyticTest").ChartObjects.Add(10 * intChartNumber, 60 + 10 * intChartNumber, 400, 300)
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).Values = dblValues
.Chart.SeriesCollection(1).XValues = strValueNames
.Chart.Axes(1).CategoryType = 2
.Chart.HasLegend = False
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "Price Changes by Commodity Code: " & snpDataList("commodity_code")
.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Part ID"
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Unit Cost Change"
.Chart.SeriesCollection(1).HasDataLabels = True
.Chart.SeriesCollection(1).HasLeaderLines = True
With .Chart.PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
.Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
.Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
.Chart.PlotArea.Fill.Visible = True
With .Chart.PlotArea.Border
.ColorIndex = 57
.Weight = xlThin
.LineStyle = xlContinuous
End With
.Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
.Chart.SeriesCollection(1).Fill.Visible = True
.Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 4
.Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
With .Chart.SeriesCollection(1).DataLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Color = RGB(255, 255, 255)
End With
With .Chart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Color = RGB(255, 255, 255)
End With
With .Chart.ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 16
.Color = RGB(0, 0, 255)
End With
End With
snpDataList.MoveNext
Loop
Set snpDataList = Nothing
End Sub
Private Sub cmdComparePC_Click()
Dim i As Long
Dim intCount As Integer
Dim intChartNumber As Integer
Dim lngRows As Long
Dim dblValues() As Double
Dim strValueNames() As String
Dim snpDataList As ADOR.Recordset
On Error Resume Next
Sheets("OracleAnalyticTest").ChartObjects.Delete
Sheets("OracleAnalyticTest").Cells(4, 1).Select
lngRows = Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2
'Set up to use ADOR to automatically sort the product codes
Set snpDataList = New ADOR.Recordset
snpDataList.Fields.Append "product_code", adVarChar, 30
snpDataList.Open
'Pick up a distinct list of product codes
For i = 4 To lngRows
'Only include those product codes with price changes
If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
If snpDataList.RecordCount > 0 Then
snpDataList.MoveFirst
End If
snpDataList.Find ("product_code = '" & Sheets("OracleAnalyticTest").Cells(i, 6) & "'")
If snpDataList.EOF Then
'Did not find a matching record
snpDataList.AddNew
snpDataList("product_code") = Sheets("OracleAnalyticTest").Cells(i, 6).Value
snpDataList.Update
End If
End If
Next i
snpDataList.Sort = "product_code"
'Find the matching rows for each product code
snpDataList.MoveFirst
Do While Not snpDataList.EOF
intCount = 0
ReDim dblValues(250)
ReDim strValueNames(250)
For i = 4 To lngRows
If intCount >= 250 Then
'Excel charts only permit about 250 data points when created with this method
Exit For
End If
If Sheets("OracleAnalyticTest").Cells(i, 6).Value = snpDataList("product_code") Then
'Found a row with this product code
If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
'Price change was found
dblValues(intCount) = Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2)
strValueNames(intCount) = Sheets("OracleAnalyticTest").Cells(i, 1).FormulaR1C1
intCount = intCount + 1
End If
End If
Next i
'Set the arrays to the exact number of elements, first element at position 0
ReDim Preserve dblValues(intCount - 1)
ReDim Preserve strValueNames(intCount - 1)
intChartNumber = intChartNumber + 1
With Sheets("OracleAnalyticTest").ChartObjects.Add(10 * intChartNumber, 60 + 10 * intChartNumber, 400, 300)
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).Values = dblValues
.Chart.SeriesCollection(1).XValues = strValueNames
.Chart.Axes(1).CategoryType = 2
.Chart.HasLegend = False
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "Price Changes by Product Code: " & snpDataList("product_code")
.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Part ID"
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Unit Cost Change"
.Chart.SeriesCollection(1).HasDataLabels = True
.Chart.SeriesCollection(1).HasLeaderLines = True
With .Chart.PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
.Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
.Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
.Chart.PlotArea.Fill.Visible = True
With .Chart.PlotArea.Border
.ColorIndex = 57
.Weight = xlThin
.LineStyle = xlContinuous
End With
.Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
.Chart.SeriesCollection(1).Fill.Visible = True
.Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 5
.Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
With .Chart.SeriesCollection(1).DataLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Color = RGB(255, 255, 255)
End With
With .Chart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Color = RGB(255, 255, 255)
End With
With .Chart.ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 16
.Color = RGB(0, 0, 255)
End With
End With
snpDataList.MoveNext
Loop
Set snpDataList = Nothing
End Sub
Private Sub cmdCompareVendorID_Click()
Dim i As Long
Dim intCount As Integer
Dim intChartNumber As Integer
Dim lngRows As Long
Dim dblValues() As Double
Dim strValueNames() As String
Dim snpDataList As ADOR.Recordset
On Error Resume Next
Sheets("OracleAnalyticTest").ChartObjects.Delete
Sheets("OracleAnalyticTest").Cells(4, 1).Select
lngRows = Sheets("OracleAnalyticTest").UsedRange.Rows.Count + 2
'Set up to use ADOR to automatically sort the product codes
Set snpDataList = New ADOR.Recordset
snpDataList.Fields.Append "vendor_id", adVarChar, 30
snpDataList.Open
'Pick up a distinct list of vendor IDs
For i = 4 To lngRows
'Only include those vendor IDs with price changes
If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
If snpDataList.RecordCount > 0 Then
snpDataList.MoveFirst
End If
snpDataList.Find ("vendor_id = '" & Sheets("OracleAnalyticTest").Cells(i, 2) & "'")
If snpDataList.EOF Then
'Did not find a matching record
snpDataList.AddNew
snpDataList("vendor_id") = Sheets("OracleAnalyticTest").Cells(i, 2).Value
snpDataList.Update
End If
End If
Next i
snpDataList.Sort = "vendor_id"
'Find the matching rows for each product code
snpDataList.MoveFirst
Do While Not snpDataList.EOF
intCount = 0
ReDim dblValues(250)
ReDim strValueNames(250)
For i = 4 To lngRows
If intCount >= 250 Then
'Excel charts only permit about 250 data points when created with this method
Exit For
End If
If Sheets("OracleAnalyticTest").Cells(i, 2).Value = snpDataList("vendor_id") Then
'Found a row with this product code
If (Sheets("OracleAnalyticTest").Cells(i, 5).Value <> 0) And (Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2) <> 0) Then
'Price change was found
dblValues(intCount) = Round(Sheets("OracleAnalyticTest").Cells(i, 3).Value - Sheets("OracleAnalyticTest").Cells(i, 5).Value, 2)
strValueNames(intCount) = Sheets("OracleAnalyticTest").Cells(i, 1).FormulaR1C1
intCount = intCount + 1
End If
End If
Next i
'Set the arrays to the exact number of elements, first element at position 0
ReDim Preserve dblValues(intCount - 1)
ReDim Preserve strValueNames(intCount - 1)
intChartNumber = intChartNumber + 1
With Sheets("OracleAnalyticTest").ChartObjects.Add(10 * intChartNumber, 60 + 10 * intChartNumber, 400, 300)
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).Values = dblValues
.Chart.SeriesCollection(1).XValues = strValueNames
.Chart.Axes(1).CategoryType = 2
.Chart.HasLegend = False
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "Price Changes by Vendor: " & snpDataList("vendor_id")
.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Part ID"
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Unit Cost Change"
.Chart.SeriesCollection(1).HasDataLabels = True
.Chart.SeriesCollection(1).HasLeaderLines = True
With .Chart.PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
.Chart.PlotArea.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.756847486076142
.Chart.PlotArea.Fill.ForeColor.SchemeColor = 23
.Chart.PlotArea.Fill.Visible = True
With .Chart.PlotArea.Border
.ColorIndex = 57
.Weight = xlThin
.LineStyle = xlContinuous
End With
.Chart.SeriesCollection(1).Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.2
.Chart.SeriesCollection(1).Fill.Visible = True
.Chart.SeriesCollection(1).Fill.ForeColor.SchemeColor = 45
.Chart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 2
With .Chart.SeriesCollection(1).DataLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Color = RGB(255, 255, 255)
End With
With .Chart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Color = RGB(255, 255, 255)
End With
With .Chart.ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 16
.Color = RGB(0, 0, 255)
End With
End With
snpDataList.MoveNext
Loop
Set snpDataList = Nothing
End Sub
If we switch back to the Excel worksheet, the remaining three buttons should now work. Clicking each button will cause Excel to examine the data in the worksheet to locate all of the unique values for PRODUCT_CODE, COMMODITY_CODE, or VENDOR_ID, and then sort the list in alphabetical order, and build a chart for each of the part IDs that fall into those categories. The results for my test run of each button looks like the following three pictures.
You can, of course, adapt the code to work with other SQL statements and modify the chart generating code to alter the chart type, colors, and fonts.
Charles Hooper's Oracle Notes 
[…] in both 10g and 11g which were detailed in David’s Blackhat presentation on February 2nd 2010. Excel – Charting the Results of Oracle Analytic Functions This is a somewhat complicated example that builds a couple of sample tables, uses a SQL statement […]
[…] Example of building Excel charts on demand using data from Oracle: https://hoopercharles.wordpress.com/2010/02/06/excel-charting-the-results-of-oracle-analytic-function… Auto-scrolling charts in Excel: […]