[AccessD] Quartile

Hi Marty

I doubt very much the GetRows() method will be faster as you will read in the full recordset while I only open the recordset, count records and move to one or two records.
The SQL method is quite convoluted even for the simple Median, for Quartiles it will get much worse:

  http://www.aspfaq.com/show.asp?id=2506

not to say if you will not calculate on the full table but only a part of it.

If having large recordset and true speed is a must, I guess you have to move to a server engine and stored procedures or OLAP.

/gustav

>>> martyconnelly at shaw.ca 01-03-2006 00:18 >>>
This code has excel limits, arrays limited to 64K but maybe the initial 
part using getrows on a recordset and moving the field
into another array might help you or maybe faster. Don Celko had an SQL 
percentile method in "SQL for Smarties" but even he suggested
using SAS or SPSS for large datasets or using OLAP.

Function TestRecordset()
 Dim strConnect As String
 Dim arRs As Variant
 Dim strsql As String

strsql = "SELECT DISTINCTROW Format([ShippedDate],""yyyy""),[Order 
Subtotals].Subtotal, Orders.OrderID " & _
"FROM Orders INNER JOIN [Order Subtotals] ON Orders.OrderID = [Order 
Subtotals].OrderID " & _
"WHERE (Orders.ShippedDate Is Not Null);"
Debug.Print strsql
  strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
  "Data Source=""C:\Program Files\Microsoft Office\Office\Samples\Copy 
of Northwind.mdb"";"
 Dim objCnn As Object
 Dim objRs As Object
  Set objCnn = CreateObject("ADODB.Connection")
  objCnn.Open strConnect
  Set objRs = CreateObject("ADODB.Recordset")
  objRs.Open strsql, objCnn
   If objRs.EOF = False Then
       arRs = objRs.GetRows
   Else
       arRs = "no results"
   End If
 
  
   Dim arRsT() As Double
   Dim myubnd As Long
   Dim mylbnd As Long
   myubnd = UBound(arRs, 2)
   mylbnd = LBound(arRs, 2)
   ReDim arRsT(mylbnd To myubnd)
   'Excel arrays get confused unless this done
    ' with passed arrays and limits of 64K
   
   Dim i As Long
   'stuff sql query field "subtotal" into a new array
   For i = 0 To UBound(arRs, 2)
 
      arRsT(i) = arRs(1, i)
  
   Next i
 
   Debug.Print Pctile(arRsT, 0.75)
   Debug.Print "1st quartile=" & quartile(arRsT, 1)
    Debug.Print "2nd quartile=" & quartile(arRsT, 2)
     Debug.Print "3'd quartile=" & quartile(arRsT, 3)
      Debug.Print "min " & quartile(arRsT, 0)
       Debug.Print "max " & quartile(arRsT, 4)
        Debug.Print "95% percentile " & Pctile(arRsT, 0.95)
   objRs.Close
   Set objRs = Nothing
   objCnn.Close
   Set objCnn = Nothing
 
  TestRecordset = arRs
End Function
Function Pctile(data, pct) As Double
Dim objExcel As Object
    Set objExcel = CreateObject("Excel.Application")
    Pctile = objExcel.Application.percentile(data, pct)
    objExcel.Quit
    Set objExcel = Nothing
End Function
Function quartile(data, pct As Long) As Double
Dim objExcel As Object
    Set objExcel = CreateObject("Excel.Application")
    quartile = objExcel.Application.quartile(data, pct)
    objExcel.Quit
    Set objExcel = Nothing
End Function