Here is my answer to certain functions that should accommodate 3D ranges but were ignored by Excel developers. This is Part 1 of 2. Part 2 contains only Private Sub ModuleFunctions_Register.
Option Explicit
'
' This module includes code for the following Public Functions (UDFs)
' COUNTBLANK3D, COUNTIF3D, SUMIF3D, AVERAGEIF3D, MAXIF3D, MINIF3D, plus MAXIF, MINIF,
' plus code for Private Function Func3D to support Public Functions indicated above,
' plus code for Private Sub ModuleFunctions_Register to register the Public Functions indicated above.
' These "3D" UDFs extend Excel's built-in functions to provide support for 3D ranges.
' see https://bettersolutions.com/excel/formulas/three-dimensional.htm
' MAXIF and MINIF (not built-in by Microsoft) are designed analogous to SUMIF;
' see comments regarding Office 365/2019+ in code for MAXIF and MINIF.
'
' Nov 2019 by J. Woolley
'
Private Function Func3D(Func As String, FirstSheetRange As Range, LastSheetRange As Variant, _
Optional Criteria As Variant, Optional AltRange As Variant) As Variant
'
' Given FirstSheetRange and LastSheetRange (common contiguous ranges on first and last of
' sequential worksheets in any single workbook), return Func result for 3D range
'
Dim oWB As Workbook, sAddress As String, sAltAddress As String
Dim nFirstSheet As Long, nLastSheet As Long, nStep As Long, n As Long
Dim vResult As Variant, vM As Variant, bFirst As Boolean
Dim rRange As Range, rAltRange As Range
On Error GoTo ErrorHandler
With FirstSheetRange
sAddress = .Address
Set oWB = .Parent.Parent
nFirstSheet = .Parent.Index
End With
If IsMissing(LastSheetRange) Then
nLastSheet = nFirstSheet
ElseIf TypeName(LastSheetRange) = "Range" Then
With LastSheetRange
If (.Parent.Parent Is oWB) Then
nLastSheet = .Parent.Index
Else
GoTo ErrorHandler
End If
End With
Else
GoTo ErrorHandler
End If
If IsMissing(AltRange) Then
Set rAltRange = FirstSheetRange
ElseIf TypeName(AltRange) = "Range" Then
Set rAltRange = AltRange
Else
GoTo ErrorHandler
End If
sAltAddress = rAltRange.Address
vResult = 0
bFirst = True
nStep = IIf(nLastSheet < nFirstSheet, -1, 1)
For n = nFirstSheet To nLastSheet Step nStep
Set rRange = oWB.Worksheets(n).Range(sAddress)
If nFirstSheet <> nLastSheet Then
Set rAltRange = oWB.Worksheets(n).Range(sAltAddress)
End If
With Application.WorksheetFunction
Select Case UCase(Func)
Case "COUNTBLANK"
vResult = vResult + .COUNTBLANK(rRange)
Case "COUNTIF"
vResult = vResult + .CountIf(rRange, Criteria)
Case "SUMIF"
vResult = vResult + .SumIf(rRange, Criteria, rAltRange)
Case "MAXIF"
vM = MAXIF(rRange, Criteria, rAltRange)
If bFirst Then
vResult = vM
bFirst = False
ElseIf vM > vResult Then
vResult = vM
End If
Case "MINIF"
vM = MINIF(rRange, Criteria, rAltRange)
If bFirst Then
vResult = vM
bFirst = False
ElseIf vM < vResult Then
vResult = vM
End If
Case Else
GoTo ErrorHandler
End Select
End With
Next n
Func3D = vResult
Exit Function
ErrorHandler:
If Err <> 0 Then Debug.Print "Error"; Err; Err.Description
On Error GoTo 0
Func3D = CVErr(xlErrValue)
End Function
Public Function COUNTBLANK3D(FirstSheetRange As Range, _
Optional LastSheetRange As Variant) As Variant
'
' COUNTBLANK for 3D range (common contiguous range on sequential worksheets in any single workbook)
' Example: =COUNTBLANK3D('My Sheet1'!A1:C6,'My Sheet3'!A1:C6)
'
COUNTBLANK3D = Func3D("COUNTBLANK", FirstSheetRange, LastSheetRange)
End Function
Public Function COUNTIF3D(FirstSheetRange As Range, Criteria As Variant, _
Optional LastSheetRange As Variant) As Variant
'
' COUNTIF for 3D range (common contiguous range on sequential worksheets in any single workbook)
' Example: =COUNTIF3D('My Sheet1'!A1:C6,">=13",'My Sheet3'!A1:C6)
'
COUNTIF3D = Func3D("COUNTIF", FirstSheetRange, LastSheetRange, Criteria)
End Function
Public Function SUMIF3D(FirstSheetRange As Range, Criteria As Variant, _
Optional AltRange As Variant, Optional LastSheetRange As Variant) As Variant
'
' SUMIF for 3D ranges (common contiguous ranges on sequential worksheets in any single workbook)
' Common contiguous ranges are evaluated for each worksheet; therefore, AltRange applies
' to all worksheets unless LastSheetRange is either omitted or set to FirstSheetRange.
' AltRange will be adjusted to the same size and shape as FirstSheetRange.
' Example: =SUMIF3D('My Sheet1'!A1:C6,">=13",B4:D9,'My Sheet3'!A1:C6)
'
SUMIF3D = Func3D("SUMIF", FirstSheetRange, LastSheetRange, Criteria, AltRange)
End Function
Public Function AVERAGEIF3D(FirstSheetRange As Range, Criteria As Variant, _
Optional AltRange As Variant, Optional LastSheetRange As Variant) As Variant
'
' AVERAGEIF for 3D ranges (common contiguous ranges on sequential worksheets in any single workbook)
' Common contiguous ranges are evaluated for each worksheet; therefore, AltRange applies
' to all worksheets unless LastSheetRange is either omitted or set to FirstSheetRange.
' AltRange will be adjusted to the same size and shape as FirstSheetRange.
' Example: =AVERAGEIF3D('My Sheet1'!A1:C6,">=13",B4:D9,'My Sheet3'!A1:C6)
'
Dim X As Variant
X = Func3D("COUNTIF", FirstSheetRange, LastSheetRange, Criteria)
If X = 0 Then
AVERAGEIF3D = CVErr(xlErrDiv0)
Else
AVERAGEIF3D = Func3D("SUMIF", FirstSheetRange, LastSheetRange, Criteria, AltRange) / X
End If
End Function
Public Function MAXIF3D(FirstSheetRange As Range, Criteria As Variant, _
Optional AltRange As Variant, Optional LastSheetRange As Variant) As Variant
'
' MAXIF for 3D range (common contiguous range on sequential worksheets in any single workbook)
' Common contiguous ranges are evaluated for each worksheet; therefore, AltRange applies
' to all worksheets unless LastSheetRange is either omitted or set to FirstSheetRange.
' AltRange will be adjusted to the same size and shape as FirstSheetRange.
' Example: =MAXIF3D('My Sheet1'!A1:C6,">=13",B4:D9,'My Sheet3'!A1:C6)
'
MAXIF3D = Func3D("MAXIF", FirstSheetRange, LastSheetRange, Criteria, AltRange)
End Function
Public Function MINIF3D(FirstSheetRange As Range, Criteria As Variant, _
Optional AltRange As Variant, Optional LastSheetRange As Variant) As Variant
'
' MINIF for 3D range (common contiguous range on sequential worksheets in any single workbook)
' Common contiguous ranges are evaluated for each worksheet; therefore, AltRange applies
' to all worksheets unless LastSheetRange is either omitted or set to FirstSheetRange.
' AltRange will be adjusted to the same size and shape as FirstSheetRange.
' Example: =MINIF3D('My Sheet1'!A1:C6,">=13",B4:D9,'My Sheet3'!A1:C6)
'
MINIF3D = Func3D("MINIF", FirstSheetRange, LastSheetRange, Criteria, AltRange)
End Function
Public Function MAXIF(Range As Range, Criteria As Variant, _
Optional AltRange As Variant) As Variant ' see comments re. Office 365/2019+
'
' MAXIF for 1D ranges (contiguous ranges on any worksheets in any single workbook)
' AltRange and Range need not be on the same worksheet.
' AltRange will be adjusted to the same size and shape as Range.
' Example: =MAXIF('My Sheet1'!A1:C6,">=13",'My Sheet3'!B4:D9)
'
Dim nRows As Long, nCols As Long, rAltRange As Range
nRows = Range.Rows.Count
nCols = Range.Columns.Count
If IsMissing(AltRange) Then
Set rAltRange = Range
ElseIf TypeName(AltRange) = "Range" Then
Set rAltRange = AltRange.Resize(nRows, nCols)
Else
MAXIF = CVErr(xlErrValue)
Exit Function
End If
' The following statement requires Office 365/2019+
MAXIF = Application.WorksheetFunction.MaxIfs(rAltRange, Range, Criteria)
' If Office 365/2019+ is not available, disable the previous statement and enable the remainder
' Dim nRow As Long, nCol As Long, vResult As Variant, vM As Variant, bFirst As Boolean
' bFirst = True
' With Application.WorksheetFunction
' For nCol = 1 To nCols
' For nRow = 1 To nRows
' If .CountIf(Range.Cells(nRow, nCol), Criteria) > 0 Then
' vM = rAltRange.Cells(nRow, nCol)
' If .IsNumber(vM) Then
' If bFirst Then
' vResult = vM
' bFirst = False
' ElseIf vM > vResult Then
' vResult = vM
' End If
' End If
' End If
' Next nRow
' Next nCol
' End With
' MAXIF = vResult
End Function
Public Function MINIF(Range As Range, Criteria As Variant, _
Optional AltRange As Variant) As Variant ' see comments re. Office 365/2019+
'
' MINIF for 1D ranges (contiguous ranges on any worksheets in any single workbook)
' AltRange and Range need not be on the same worksheet.
' AltRange will be adjusted to the same size and shape as Range.
' Example: =MINIF('My Sheet1'!A1:C6,">=13",'My Sheet3'!B4:D9)
'
Dim nRows As Long, nCols As Long, rAltRange As Range
nRows = Range.Rows.Count
nCols = Range.Columns.Count
If IsMissing(AltRange) Then
Set rAltRange = Range
ElseIf TypeName(AltRange) = "Range" Then
Set rAltRange = AltRange.Resize(nRows, nCols)
Else
MINIF = CVErr(xlErrValue)
Exit Function
End If
' The following statement requires Office 365/2019+
MINIF = Application.WorksheetFunction.MinIfs(rAltRange, Range, Criteria)
' If Office 365/2019+ is not available, disable the previous statement and enable the remainder
' Dim nRow As Long, nCol As Long, vResult As Variant, vM As Variant, bFirst As Boolean
' bFirst = True
' With Application.WorksheetFunction
' For nCol = 1 To nCols
' For nRow = 1 To nRows
' If .CountIf(Range.Cells(nRow, nCol), Criteria) > 0 Then
' vM = rAltRange.Cells(nRow, nCol)
' If .IsNumber(vM) Then
' If bFirst Then
' vResult = vM
' bFirst = False
' ElseIf vM < vResult Then
' vResult = vM
' End If
' End If
' End If
' Next nRow
' Next nCol
' End With
' MINIF = vResult
End Function
