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 MIN, MAX or SUM on a list of given number or string combinations, you can use Mfreq.

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

 Function Mfreq(sFunction As String, ParamArray v()) As Variant'Mfreq performs the function sFunction on last given column per'combination of the previous ones. 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:F3 and array-enter'=Mfreq("sum",A1:A5,B1:B5,C1:C5) and you will get'     D     E    F' 1 Smith  Adam  8' 2 Myer   Ben   7' 3 Smith  Ben   2'Reverse("moc.liborplus.www") V0.4 15-Oct-2009Dim obj As ObjectDim vR As VariantDim i As Long, j As Long, k As Long, lvdim As LongDim s As String, sC As StringWith Application.WorksheetFunctionsC = "|"Set obj = CreateObject("Scripting.Dictionary")k = 0v(0) = .Transpose(.Transpose(v(0)))If UBound(v) < 1 Then    Mfreq = CVErr(xlErrValue)    Exit FunctionEnd Iflvdim = UBound(v(0))If lvdim > 100 Then lvdim = 100 'Let us start with small dimOn Error GoTo ErrHdl 'Please read                               'http://www.sulprobil.com/Get_it_done/IT/Excel_Fun/Excel_VBA/Error_Trapping/error_trapping.htmlReDim vR(0 To UBound(v), 1 To lvdim)For i = 1 To UBound(v(0))    s = v(0)(i, 1)    For j = 1 To UBound(v) - 1        v(j) = .Transpose(.Transpose(v(j)))        s = s & sC & v(j)(i, 1)    Next j    If obj.Item(s) > 0 Then        Select Case LCase(sFunction)        Case "sum"            vR(UBound(v), obj.Item(s)) = vR(UBound(v), _                obj.Item(s)) + v(UBound(v))(i, 1)        Case "max"            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"            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 Else            Mfreq = CVErr(xlErrRef)        End Select    Else        k = k + 1        obj.Item(s) = k        For j = 0 To UBound(v) - 1            vR(j, k) = v(j)(i, 1)        Next j        vR(UBound(v), k) = v(UBound(v))(i, 1)    End IfNext i'Reduce result array to used areaIf k > 0 Then ReDim Preserve vR(0 To UBound(v), 1 To k)Mfreq = .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), 1 To lvdim)       Err.Number = 0       Resume 'Back to statement which caused error   End IfEnd If'Other error - terminateOn Error GoTo 0ResumeEnd Function
 Sulprobil   Get it done   Contact   Disclaimer   Impressum   Download