Subtotal_Indirects

Finds the SUM, COUNT, COUNTA, etc for a range of cells referencing using INDIRECT function method
Passing column name, and list of rows separated by certain char, the function will return SUM (or others) of that group of cells
Needed when you need to have list of rows variable, meaning you do not always use the same rows to get their SUM (or others)
Uses same Function_Num as in SUBTOTAL Excel function
    ' Function_Num Ignore hidden
    ' 1        101        AVERAGE
    ' 2        102        COUNT
    ' 3        103        COUNTA
    ' 4        104        MAX
    ' 5        105        MIN
    ' 6        106        PRODUCT
    ' 7        107        STDEV
    ' 8        108        STDEVP
    ' 9        109        SUM
    ' 10    110        VAR
    ' 11    111        VARP

CodeFunctionName
What is this?

Public

Tested

Original Work
Function Subtotal_Indirects(Function_Num, ColumnName, List_of_Rows, Optional Sepa = "|", Optional Shee = "Active", Optional WB = "This")
    ' Finds the Sum, count, countA, etc for a range of cells referencing using INDIRECT function method
    ' Passing column name, and list of rows separated by certain char, the function will return SUM (or others) of that group of cells
    ' Needed when you need to have list of rows variable, meaning you do not always use the same rows to get thier SUM (or others)
    ' Function_Num Ignore hidden
    ' 1        101        AVERAGE
    ' 2        102        COUNT
    ' 3        103        COUNTA
    ' 4        104        MAX
    ' 5        105        MIN
    ' 6        106        PRODUCT
    ' 7        107        STDEV
    ' 8        108        STDEVP
    ' 9        109        SUM
    ' 10    110        VAR
    ' 11    111        VARP
    If WB = "This" Then WB = ThisWorkbook.Name
    If WB = "Active" Then WB = ActiveWorkbook.Name
    If Shee = "Active" Then Shee = Workbooks(WB).Activesheet.Name
    Rett = "N/A"
    Dim OutArr()
    X1 = 1
    X2 = 0
    For Each Ro1 In Split(List_of_Rows, Sepa)
        Ro1 = Val(Ro1)
        If Ro1 = 0 Then GoTo NextX1
        Ro1V = Workbooks(WB).Worksheets(Shee).Range(ColumnName & Ro1).Value
        If Not IsNumeric(Ro1V) Then GoTo NextX1
        If IsEmpty(Ro1V) Then GoTo NextX1
        X2 = X2 + 1
        ReDim Preserve OutArr(X1)
        OutArr(X1) = Val(Ro1V)
NextX1:
        X1 = X1 + 1
    Next
    If X2 > 0 Then
        Select Case Function_Num
        Case 1:                TotalOf = WorksheetFunction.Average(OutArr())
        Case 2:                TotalOf = WorksheetFunction.Count(OutArr())
        Case 3:                TotalOf = WorksheetFunction.CountA(OutArr())
        Case 4:                TotalOf = WorksheetFunction.Max(OutArr())
        Case 5:                TotalOf = WorksheetFunction.Min(OutArr())
        Case 6:                TotalOf = WorksheetFunction.Product(OutArr())
        Case 7:                TotalOf = WorksheetFunction.StDev(OutArr())
        Case 8:                TotalOf = WorksheetFunction.StDevP(OutArr())
        Case 9:                TotalOf = WorksheetFunction.Sum(OutArr())
        Case 10:                TotalOf = WorksheetFunction.Var(OutArr())
        Case 11:                TotalOf = WorksheetFunction.VarP(OutArr())
        End Select
        Rett = TotalOf
    End If
    Subtotal_Indirects = Rett
End Function

Function_Num, ColumnName, List_of_Rows, Optional Sepa = "|", Optional Shee = "Active", Optional WB = "This"

Views 141

Downloads 34

CodeID
DB ID