1
\$\begingroup\$

The Setup

I have a table (call it myTable) in MS Access with two fields: Item (Text) and Quantity (Long).

For example, the first 10 records might be:

Item      |  Quantity
----------+----------
Item001   |       706
Item002   |       533
Item003   |       580
Item004   |       289
Item005   |       302
Item006   |       775
Item007   |        14
Item008   |       761
Item009   |       815
Item010   |       709

The Task

I'm looking to obtain a table/query containing the top N records whose Quantity constitutes a given percentage of the total Quantity across all records.

For example:

If the total of the Quantity field for all records is 1000 and the given percentage is 80%, the output table/query would contain sufficient records in decreasing Quantity until the total Quantity is 800.


My Code

Here is my current approach:

Function Percentile(dblPct As Double)
    On Error GoTo Cleanup
    Dim dbsCdb As DAO.Database
    Dim rstRs1 As DAO.Recordset
    Dim rstRs2 As DAO.Recordset
    Dim lngTot As Long
    Dim lngSum As Long
    Dim lngRcd As Long

    Set dbsCdb = CurrentDb
    Set rstRs1 = dbsCdb.OpenRecordset("SELECT Sum(Quantity) FROM myTable")

    With rstRs1
        If Not .EOF Then
            .MoveFirst
            lngTot = .Fields(0) * dblPct
        End If
        .Close
    End With
    Set rstRs1 = Nothing

    If 0 < lngTot Then
        Set rstRs2 = dbsCdb.OpenRecordset("SELECT * FROM myTable ORDER BY Quantity DESC")
        With rstRs2
            If Not .EOF Then
                .MoveFirst
                Do Until .EOF Or lngSum >= lngTot
                    lngRcd = lngRcd + 1
                    lngSum = lngSum + !Quantity
                    .MoveNext
                Loop
            End If
            .Close
        End With
        Set rstRs2 = Nothing

        DoCmd.RunSQL "SELECT TOP " & lngRcd & " * INTO OutputTable FROM myTable ORDER BY Quantity DESC"
    End If

Cleanup:
    On Error Resume Next
    If Not (rstRs1 Is Nothing) Then rstRs1.Close: Set rstRs1 = Nothing
    If Not (rstRs2 Is Nothing) Then rstRs2.Close: Set rstRs2 = Nothing
    If Not (dbsCdb Is Nothing) Then Set dbsCdb = Nothing
End Function
  1. I first calculate the total Quantity of all records in myTable and multiply this by the given percentage argument (e.g. 0.8 for 80%).
  2. I then iterate over the records in descending order of Quantity and calculate a running total, ceasing when this total is greater than or equal to the target, counting the number of records it takes to do so.
  3. Finally, I select the calculated number of records from the table to create an OutputTable.

What I'm Hoping For

  • I'm relatively new to VBA, so feedback on any obvious bad practices in my code would be appreciated.

  • I feel like I'm missing something obvious - could this be achieved using one or two SQL statements?


Many thanks in advance for your time!

\$\endgroup\$
0
\$\begingroup\$

I can't think of a real-world scenario why you need this. Especially

the output table/query would contain sufficient records in decreasing Quantity until the [requested] Quantity in % is reached

Maybe ascending would make sense to me which will ship out all small quantities first to clear the warehouse?

Anyhow, you don't need VBA for this. Although Access SQL isn't flexible like other modern DBMS, this is certainly achievable with MS Access SQL. (Questions may arise regarding performance hits)

First create a query to generate percentile for each row.

SELECT ItemQuantityTable.id
    ,ItemQuantityTable.item
    ,ItemQuantityTable.quantity
    ,([quantity] * 100) / (
        SELECT sum(quantity)
        FROM ItemQuantityTable AS Ts
        ) AS ValueInPercent
FROM ItemQuantityTable
GROUP BY ItemQuantityTable.id
    ,ItemQuantityTable.item
    ,ItemQuantityTable.quantity;

This will return something like this.

+----+---------+----------+------------------+
| id |  item   | quantity |  ValueInPercent  |
+----+---------+----------+------------------+
|  1 | Item001 |      706 |  12.873814733771 |
|  2 | Item002 |      533 | 9.71918307804522 |
|  3 | Item003 |      580 | 10.5762217359592 |
|  4 | Item004 |      289 | 5.26987600291758 |
|  5 | Item005 |      302 | 5.50692924872356 |
|  6 | Item006 |      775 | 14.1320204230489 |
|  7 | Item007 |       14 | 0.25528811086798 |
|  8 | Item008 |      761 | 13.8767323121809 |
|  9 | Item009 |      815 | 14.8614150255288 |
| 10 | Item010 |      709 |  12.928519328957 |
+----+---------+----------+------------------+

Now you know each item's quantity in percentile compared to the total quantity. logically, the next step would be create a new column and add all previous [valueInPercent] including current row. This should give you summing all percentiles up to the current row. Finally you can then request show me all records less or equal to your given %.

Create a new query to generate the new [total up to current row] column.

SELECT tOuter.id
    ,tOuter.item
    ,tOuter.quantity
    ,tOuter.ValueInPercent
    ,(
        SELECT sum(Trs.valueInPercent)
        FROM [questions_184789] AS Trs
        WHERE (touter.quantity <= trs.quantity)
        ) AS RowTotalPercent
FROM questions_184789 AS tOuter
ORDER BY tOuter.quantity desc;

This gives something like this:

+----+---------+----------+------------------+------------------+
| id |  item   | quantity |  ValueInPercent  | RowTotalPercent  |
+----+---------+----------+------------------+------------------+
|  9 | Item009 |      815 | 14.8614150255288 | 14.8614150255288 |
|  6 | Item006 |      775 | 14.1320204230489 | 28.9934354485777 |
|  8 | Item008 |      761 | 13.8767323121809 | 42.8701677607586 |
| 10 | Item010 |      709 |  12.928519328957 | 55.7986870897155 |
|  1 | Item001 |      706 |  12.873814733771 | 68.6725018234865 |
|  3 | Item003 |      580 | 10.5762217359592 | 79.2487235594457 |
|  2 | Item002 |      533 | 9.71918307804522 | 88.9679066374909 |
|  5 | Item005 |      302 | 5.50692924872356 | 94.4748358862145 |
|  4 | Item004 |      289 | 5.26987600291758 |  99.744711889132 |
|  7 | Item007 |       14 | 0.25528811086798 |              100 |
+----+---------+----------+------------------+------------------+

at this point it should be pretty much clear what the next step would be. just create your third query

Select * from finalQuery where RowTotalPercent <= 80

result:

+----+---------+----------+------------------+------------------+
| id |  item   | quantity |  ValueInPercent  | RowTotalPercent  |
+----+---------+----------+------------------+------------------+
|  9 | Item009 |      815 | 14.8614150255288 | 14.8614150255288 |
|  6 | Item006 |      775 | 14.1320204230489 | 28.9934354485777 |
|  8 | Item008 |      761 | 13.8767323121809 | 42.8701677607586 |
| 10 | Item010 |      709 |  12.928519328957 | 55.7986870897155 |
|  1 | Item001 |      706 |  12.873814733771 | 68.6725018234865 |
|  3 | Item003 |      580 | 10.5762217359592 | 79.2487235594457 |
+----+---------+----------+------------------+------------------+

No VBA used just SQL. Hope this is what you wanted?

\$\endgroup\$
  • \$\begingroup\$ Many thanks! Your SQL approach is very similar to the SQL suggested by @this though slightly more modular and therefore easier to comprehend. \$\endgroup\$ – Lee Mac Jan 13 '18 at 13:17
  • \$\begingroup\$ Regarding the real-world use for such a query: this particular task was to identify the fewest number of items which contribute a given percentage to the overall total, so that other items which contribute a far smaller percentage could be safely ignored whilst a given percentage of the overall total is maintained - hope this makes some sense. \$\endgroup\$ – Lee Mac Jan 13 '18 at 13:20
0
\$\begingroup\$

This is very good question and a very hard one because your query is basically sensitive to the ordering. In other SQL database engines, this is easier to solve with use of window functions. Unfortunately, Access database engine does not support window functions.

A possible choice is to use subquery but this can get very expensive quickly because a subquery would have to be correlated and therefore re-calculated for all possible rows, making it O(too much n). For completeness' sake, here's a possible query:

SELECT 
  m.Item, 
  m.Quantity, 
  (
    SELECT SUM(x.Quantity) 
    FROM myTable AS x 
    WHERE x.Quantity >= m.Quantity
  ) AS RunningSum, 
  (
    SELECT SUM(t.Quantity) 
    FROM myTable AS t
  ) * 0.8 AS PercentileThreshold
FROM myTable AS m
WHERE (
  SELECT SUM(x.Quantity) 
  FROM myTable AS x 
  WHERE x.Quantity >= m.Quantity
) <= (
  SELECT SUM(t.Quantity) 
  FROM myTable AS t
) * 0.8
ORDER BY m.Quantity DESC;

To avoid paying the expenses of multiple queries being executed several times over, you can combine some VBA with SQL. For instance, you can create the following VBA in a public standard module:

Private Type TPercentile
    PercentileThreshold As Currency
    PercentileValues As Scripting.Dictionary
End Type
Private This As TPercentile

Public Function StartPercentile(PercentileThreshold As Currency) As Boolean
    This.PercentileThreshold = Nz(DSum("Quantity", "myTable") * PercentileThreshold, 0)
    Set This.PercentileValues = New Scripting.Dictionary
    StartPercentile = True
End Function

Public Function Percentile(Key As String, Quantity As Variant) As Currency
    Dim PercentileValue As Currency

    If Not This.PercentileValues.Exists(Key) Then
        PercentileValue = Nz(DSum("Quantity", "myTable", "Quantity>=" & Nz(Quantity, 0)))
        This.PercentileValues.Add Key, PercentileValue
    End If
    Percentile = This.PercentileValues(Key)
End Function

Public Function PercentileThreshold() As Currency
    PercentileThreshold = This.PercentileThreshold
End Function

Your query then becomes:

SELECT 
  m.Item, 
  m.Quantity, 
  Percentile(m.Item,m.Quantity) AS Percentile, 
  PercentileThreshold() AS Threshold
FROM myTable AS m
WHERE StartPercentile(0.8) 
  AND Percentile([m].[Item],[m].[Quantity]) <= PercentileThreshold()
ORDER BY m.Quantity DESC;

This enables you to handle a larger dataset by populating the dictionary only once and require less code to boot and you can easily generalize for other tables. The downside is that this is limited to only one active running query at a time. If this is unacceptable, then you need to add some kind of identifier that each query can then generate in their invocation to StartPercentile() function so that they have their own "instances".

I also want to call your attention to one possible option for you - If you are reporting, Access already provides you with a Running Sum property on the Report so you could conceivably create a simple query, then apply a filter on a calculated control, rather than doing in the query. That yields much less code.

You may wonder why I use Currency all over the place -- the answer is that I generally avoid using floating numbers such as Double which can cause unstable results due to rounding errors. Currency is a scaled integer and thus is not subject to such problems so it is a great data type to use for where you need fractions less than 4 decimal places. I should note that there is also a Decimal type but IME, it yields more problems than solutions and I never use it within Access/VBA context.

\$\endgroup\$
  • \$\begingroup\$ Many thanks for your feedback, I very much appreciate your time. I think your suggested solution is performing a slightly different operation however: you are selecting all records whose individual Quantity is greater than or equal to 80% of the total, as opposed to selecting the subset of records for which the total Quantity of the subset is 80% of the total Quantity of the main set. I apologise if I wasn't too clear in my original explanation, and I thank you for your response. \$\endgroup\$ – Lee Mac Jan 10 '18 at 22:06
  • \$\begingroup\$ My apologies. I did not understand question. I will revise it. \$\endgroup\$ – this Jan 11 '18 at 2:37
  • \$\begingroup\$ @LeeMac I've updated my answer to reflect the question being asked. Again, my apologies. \$\endgroup\$ – this Jan 11 '18 at 3:44
  • \$\begingroup\$ No need to apologise - I appreciate the time you have taken with your response! There are a lot of new concepts for me to digest with your code - defining Types are new to me, and the use of Scripting.Dictionary is very new! Do I need to include any non-standard references in my VBA project to use Scripting.Dictionary, as it wasn't immediately recognised? Also, would the variable This first need to be defined before setting its properties? Also, in your example, would StartPercentile(0.8) in the WHERE clause be evaluated for every record in myTable? \$\endgroup\$ – Lee Mac Jan 11 '18 at 18:57
  • \$\begingroup\$ Yes, you need a reference or use a late-bound code. The reference you need is Microsoft Scripting Runtime, or scrrun.dll located in the Windows' System32 or SysWOW64 folder (if running 32-bit on 64-bit OS). \$\endgroup\$ – this Jan 11 '18 at 21:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.