Friday, September 26, 2014

SUBTOTAL()-like UDF for cases when Rows and Columns may be hidden


The Opportunity

Thinking about it further I realized there are times when SUBTOTALS might be needed for cases when some rows and  some columns are hidden.  Consider, for example,  tables of data where a reading is taken periodically each day (days as columns and times of day labeling each row, or vice versa):   meteorological readings, manufacturing outputs,  and 24x7 schedules.

A SUBTOTAL() for a range

The Subtotal() worksheet function can be used on multiple columns of data, ignoring what is hidden by row.  The user-defined function in y ignored what was hidden by column and can used on multiple rows. One small change to the code in y (highlighted below) results a SUBTOTAL function that ignores the cell if hidden by row or hidden by column.

Function SubTotalColumns(Operation As Integer, ParamArray rngSource())
    Dim rngCell As Range
    Dim rngVisible As Range
    Dim dblCtr As Double
    For dblCtr = LBound(rngSource) To UBound(rngSource)
        For Each rngCell In rngSource(dblCtr).Cells
            If Not (rngCell.Columns.Hidden Or rngCell.Rows.Hidden) Then 
               ' Instead of  "Not rngCell.Columns(1).Hidden"
                If rngVisible Is Nothing Then
                    Set rngVisible = rngCell
                    Set rngVisible = Union(rngVisible, rngCell)
                End If
            End If
        Next rngCell
    Next dblCtr
    Select Case Operation
        Case 1
            SubTotalColumns = Application.WorksheetFunction.Average(rngVisible)
        Case 2
            SubTotalColumns = Application.WorksheetFunction.count(rngVisible)
        Case 3
            SubTotalColumns = Application.WorksheetFunction.CountA(rngVisible)
        Case 4
            SubTotalColumns = Application.WorksheetFunction.max(rngVisible)
        Case 5
            SubTotalColumns = Application.WorksheetFunction.min(rngVisible)
        Case 6
            SubTotalColumns = Application.WorksheetFunction.Product(rngVisible)
        Case 7
            SubTotalColumns = Application.WorksheetFunction.StDev(rngVisible)
        Case 8
            SubTotalColumns = Application.WorksheetFunction.StDevP(rngVisible)
        Case 9
            SubTotalColumns = Application.WorksheetFunction.Sum(rngVisible)
        Case 10
            SubTotalColumns = Application.WorksheetFunction.var(rngVisible)
        Case 11
            SubTotalColumns = Application.WorksheetFunction.varP(rngVisible)
        End Select
End Function

No comments:

Post a Comment