Abstract
If you want to apply a function like CAT, COUNT, MAX, MIN or SUM on a list of given number or string combinations with a condition applied, you can use sbMiniPivot.
Please note that I created this function just for training and for teaching purposes. sbMiniPivot(“sum”, {TRUE; …; TRUE}, …) is identical to Mfreq(“sum”, …) and to sbSfreq(…). sbMiniPivot is an array function which has to be entered with CTRL + SHIFT + ENTER, not only with ENTER.
Name
sbMiniPivot - Concatenate, sum or return min or max of last given input column for all combinations of the previous ones where same row of condition column is True
Synopsis
sbMiniPivot(sFunction, vCondition, ParamArray vInput)
Description
sbMiniPivot performs the function sFunction on last given column of vInput for all combinations of the previous ones where corresponding elements of vCondition are True. It returns a variant array.
Options
sFunction - Specifies the function which has to be applied to the combinations. Can be concatenate (cat), count, max(imum), min(imum)
vCondition - Condition column which needs to return True/False values
vInput - Two or more columns. sFunction will be applied on last input column for all combinations of the previous ones where same row of condition column is True
Appendix – sbMiniPivot Code
Please read my Disclaimer.
Option Explicit
Enum mc_Macro_Categories
mcFinancial = 1
mcDate_and_Time
mcMath_and_Trig
mcStatistical
mcLookup_and_Reference
mcDatabase
mcText
mcLogical
mcInformation
mcCommands
mcCustomizing
mcMacro_Control
mcDDE_External
mcUser_Defined
mcFirst_custom_category
mcSecond_custom_category 'and so on
End Enum 'mc_Macro_Categories
Function sbMiniPivot(sFunction As String, _
vCondition() As Variant, _
ParamArray vInput() As Variant) As Variant
'sbMiniPivot performs the function sFunction on last given column of
'vInput() for all combinations of the previous ones where corresponding
'elements of vCondition are TRUE.
'Example:
' A B C
' 1 Smith Adam 1
' 2 Myer Ben 3
' 3 Smith Ben 2
' 4 Smith Adam 7
' 5 Myer Ben 4
'Now select D1:F2 and array-enter
'=sbMiniPIvot("sum", B1:B5="Ben", A1:A5,B1:B5,C1:C5) and you will get
' D E F
' 1 Myer Ben 7
' 2 Smith Ben 2
'Source (EN): http://www.sulprobil.com/sbminipivot_en/
'Source (DE): http://www.bplumhoff.de/sbminipivot_de/
'(C) (P) by Bernd Plumhoff 29-Jun-2019 PB V1.0
Dim obj As Object
Dim vR As Variant
Dim i As Long, j As Long, k As Long
Dim lvdim As Long, lcdim As Long
Dim s As String, sC As String
Dim liscount As Long '1 if and only if we count
With Application.WorksheetFunction
sC = "|"
k = 0
vInput(0) = .Transpose(.Transpose(vInput(0)))
If LCase(sFunction) = "count" Then liscount = 1
If UBound(vInput) < 1 - liscount Then
sbMiniPivot = CVErr(xlErrValue)
Exit Function
End If
vCondition = .Transpose(.Transpose(vCondition))
lcdim = UBound(vCondition, 1)
lvdim = UBound(vInput(0))
If lcdim <> lvdim Then
sbMiniPivot = CVErr(xlErrRef)
Exit Function
End If
If lvdim > 100 Then lvdim = 100 'Let us start with small dimension
On Error GoTo ErrHdl
ReDim vR(0 To UBound(vInput) + liscount, 1 To lvdim)
For j = 1 To UBound(vInput)
vInput(j) = .Transpose(.Transpose(vInput(j)))
If lcdim <> UBound(vInput(j)) Then
sbMiniPivot = CVErr(xlErrRef)
Exit Function
End If
Next j
Set obj = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(vInput(0))
If vCondition(i, 1) Then
s = vInput(0)(i, 1)
For j = 1 To UBound(vInput) - 1 + liscount
s = s & sC & vInput(j)(i, 1)
Next j
If obj.Item(s) > 0 Then
Select Case LCase(sFunction)
Case "cat", "concatenate"
vR(UBound(vInput), obj.Item(s)) = vR(UBound(vInput), _
obj.Item(s)) & "," & vInput(UBound(vInput))(i, 1)
Case "count"
vR(UBound(vInput) + 1, obj.Item(s)) = vR(UBound(vInput) + 1, _
obj.Item(s)) + 1
Case "max", "maximum"
If vR(UBound(vInput), obj.Item(s)) < vInput(UBound(vInput))(i, 1) Then
vR(UBound(vInput), obj.Item(s)) = vInput(UBound(vInput))(i, 1)
End If
Case "min", "minimum"
If vR(UBound(vInput), obj.Item(s)) > vInput(UBound(vInput))(i, 1) Then
vR(UBound(vInput), obj.Item(s)) = vInput(UBound(vInput))(i, 1)
End If
Case "sum"
vR(UBound(vInput), obj.Item(s)) = vR(UBound(vInput), _
obj.Item(s)) + vInput(UBound(vInput))(i, 1)
Case Else
sbMiniPivot = CVErr(xlErrRef)
End Select
Else
k = k + 1
obj.Item(s) = k
For j = 0 To UBound(vInput)
vR(j, k) = vInput(j)(i, 1)
Next j
If liscount = 1 Then vR(UBound(vInput) + 1, k) = 1
End If
End If
Next i
'Reduce result array to used area
If k > 0 Then ReDim Preserve vR(0 To UBound(vInput) + liscount, 1 To k)
sbMiniPivot = .Transpose(vR)
Set obj = Nothing
End With
Exit Function
ErrHdl:
If Err.Number = 9 Then
If i > lvdim Then
'Here we normally get if we breach Ubound(vR,2)
'So we need to increase last dimension
lvdim = 10 * lvdim
If lvdim > UBound(vInput(0)) Then lvdim = UBound(vInput(0))
ReDim Preserve vR(0 To UBound(vInput) + liscount, 1 To lvdim)
Resume 'Back to statement which caused error
End If
End If
'Other error - terminate
On Error GoTo 0
Resume
End Function
Sub DescribeFunction_sbMiniPivot()
'Run this only once, then you will see this description in the function menu
Dim FuncName As String, FuncDesc As String, Category As String
Dim ArgDesc(1 To 3) As String
FuncName = "sbMiniPivot"
FuncDesc = "Concatenate, sum or return min or max of last given input " & _
"column for all combinations of the previous ones where same row " & _
"of condition column is True"
Category = mcStatistical
ArgDesc(1) = "Function to apply - cat, sum, min, or max"
ArgDesc(2) = "Condition column which needs to return True/False values"
ArgDesc(3) = "Two or more columns"
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
Category:=Category, _
ArgumentDescriptions:=ArgDesc
End Sub