I am a supporter ofSt. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation toSt. Joseph's, please. Information onSt. Joseph's

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 Pstat.

Please note that Pstat("sum", {TRUE; ...; TRUE}, ...) is identical to Mfreq("sum", ...) and to sbSfreq(...). Pstat is an array function which has to be entered with CTRL + SHIFT + ENTER, not only with ENTER.

 Function Pstat(sFunction As String, _               vCond() As Variant, _               ParamArray v() As Variant) As Variant'Pstat performs the function sFunction on last given column of v()'for all combinations of the previous ones where corresponding'elements of vCond 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'=Pstat("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'Reverse("moc.LiborPlus.www") V0.6 15-Oct-2009Dim obj As ObjectDim vR As VariantDim i As Long, j As Long, k As LongDim lvdim As Long, lcdim As LongDim s As String, sC As StringDim liscount As Long '1 if and only if we countWith Application.WorksheetFunctionsC = "|"k = 0v(0) = .Transpose(.Transpose(v(0)))If LCase(sFunction) = "count" Then liscount = 1If UBound(v) < 1 - liscount Then   Pstat = CVErr(xlErrValue)   Exit FunctionEnd IfvCond = .Transpose(.Transpose(vCond))lcdim = UBound(vCond, 1)lvdim = UBound(v(0))If lcdim <> lvdim Then   Pstat = CVErr(xlErrRef)   Exit FunctionEnd IfIf lvdim > 100 Then lvdim = 100 'Let us start with small dimOn Error GoTo ErrHdlReDim vR(0 To UBound(v) + liscount, 1 To lvdim)For j = 1 To UBound(v)   v(j) = .Transpose(.Transpose(v(j)))   If lcdim <> UBound(v(j)) Then       Pstat = CVErr(xlErrRef)       Exit Function   End IfNext jSet obj = CreateObject("Scripting.Dictionary")For i = 1 To UBound(v(0))   If vCond(i, 1) Then       s = v(0)(i, 1)       For j = 1 To UBound(v) - 1 + liscount           s = s & sC & v(j)(i, 1)       Next j       If obj.Item(s) > 0 Then           Select Case LCase(sFunction)           Case "cat", "concatenate"               vR(UBound(v), obj.Item(s)) = vR(UBound(v), _                   obj.Item(s)) & "," & v(UBound(v))(i, 1)           Case "count"               vR(UBound(v) + 1, obj.Item(s)) = vR(UBound(v) + 1, _                   obj.Item(s)) + 1           Case "max", "maximum"               If vR(UBound(v), obj.Item(s)) < v(UBound(v))(i, 1) Then                   vR(UBound(v), obj.Item(s)) = v(UBound(v))(i, 1)               End If           Case "min", "minimum"               If vR(UBound(v), obj.Item(s)) > v(UBound(v))(i, 1) Then                   vR(UBound(v), obj.Item(s)) = v(UBound(v))(i, 1)               End If           Case "sum"               vR(UBound(v), obj.Item(s)) = vR(UBound(v), _                   obj.Item(s)) + v(UBound(v))(i, 1)           Case Else               Pstat = CVErr(xlErrRef)           End Select       Else           k = k + 1           obj.Item(s) = k           For j = 0 To UBound(v)               vR(j, k) = v(j)(i, 1)           Next j           If liscount = 1 Then vR(UBound(v) + 1, k) = 1       End If   End IfNext i'Reduce result array to used areaIf k > 0 Then ReDim Preserve vR(0 To UBound(v) + liscount, 1 To k)Pstat = .Transpose(vR)Set obj = NothingEnd WithExit FunctionErrHdl: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(v(0)) Then lvdim = UBound(v(0))       ReDim Preserve vR(0 To UBound(v) + liscount, 1 To lvdim)       Err.Number = 0       Resume 'Back to statement which caused error   End IfEnd If'Other error - terminateOn Error GoTo 0ResumeEnd Function