Here's a set of UDF functions that accomplish essentially the same thing. The only caveat is that the reference to the 3D range is a string i.e. "Jan:Dec!A1"
as opposed to straight up Jan:Dec!A1
'Adapted from https://web-beta.archive.org/web/20060313132405/http://www.j-walk.com/ss/excel/eee/eee003.txt by Andre Terra
Function CountIf3D(Range3D As String, Criteria As String, _
Optional Count_Range As Variant) As Variant
Dim sTestRange As String
Dim sCountRange As String
Dim Sheet1 As Integer
Dim Sheet2 As Integer
Dim n As Integer
Dim Count As Double
Application.Volatile
If Parse3DRange(Application.Caller.Parent.Parent.Name, _
Range3D, Sheet1, Sheet2, sTestRange) = False Then
CountIf3D = CVErr(xlErrRef)
End If
If IsMissing(Count_Range) Then
sCountRange = sTestRange
Else
sCountRange = Count_Range.Address
End If
Count = 0
For n = Sheet1 To Sheet2
With Worksheets(n)
Count = Count + Application.WorksheetFunction.CountIf(.Range _
(sTestRange), Criteria)
End With
Next n
CountIf3D = Count
End Function 'CountIf3D
Function SumIf3D(Range3D As String, Criteria As String, _
Optional Sum_Range As Variant) As Variant
Dim sTestRange As String
Dim sSumRange As String
Dim Sheet1 As Integer
Dim Sheet2 As Integer
Dim n As Integer
Dim Sum As Double
Application.Volatile
If Parse3DRange(Application.Caller.Parent.Parent.Name, _
Range3D, Sheet1, Sheet2, sTestRange) = False Then
SumIf3D = CVErr(xlErrRef)
End If
If IsMissing(Sum_Range) Then
sSumRange = sTestRange
Else
sSumRange = Sum_Range.Address
End If
Sum = 0
For n = Sheet1 To Sheet2
With Worksheets(n)
Sum = Sum + Application.WorksheetFunction.SumIf(.Range _
(sTestRange), Criteria, .Range(sSumRange))
End With
Next n
SumIf3D = Sum
End Function 'SumIf3D
Function AverageIf3D(Range3D As String, Criteria As String, _
Optional Average_Range As Variant) As Variant
Dim sTestRange As String
Dim sSumRange As String
Dim Sheet1 As Integer
Dim Sheet2 As Integer
Dim n As Integer
Dim Sum As Double
Dim Count As Double
Application.Volatile
If Parse3DRange(Application.Caller.Parent.Parent.Name, _
Range3D, Sheet1, Sheet2, sTestRange) = False Then
AverageIf3D = CVErr(xlErrRef)
End If
If IsMissing(Average_Range) Then
sSumRange = sTestRange
Else
sSumRange = Average_Range.Address
End If
Sum = 0
Count = 0
For n = Sheet1 To Sheet2
With Worksheets(n)
Sum = Sum + Application.WorksheetFunction.SumIf(.Range(sTestRange), Criteria, .Range(sSumRange))
Count = Count + Application.WorksheetFunction.CountIf(.Range(sTestRange), Criteria)
End With
Next n
AverageIf3D = Sum / Count
End Function 'SumIf3D
Function Parse3DRange(sBook As String, SheetsAndRange _
As String, FirstSheet As Integer, LastSheet As Integer, _
sRange As String) As Boolean
Dim sTemp As String
Dim i As Integer
Dim Sheet1 As String
Dim Sheet2 As String
Parse3DRange = False
On Error GoTo Parse3DRangeError
sTemp = SheetsAndRange
i = InStr(sTemp, "!")
If i = 0 Then Exit Function
'next line will generate an error if range is invalid
'if it's OK, it will be converted to absolute form
sRange = Range(Mid$(sTemp, i + 1)).Address
sTemp = Left$(sTemp, i - 1)
i = InStr(sTemp, ":")
Sheet2 = Trim(Mid$(sTemp, i + 1))
If i > 0 Then
Sheet1 = Trim(Left$(sTemp, i - 1))
Else
Sheet1 = Sheet2
End If
'next lines will generate errors if sheet names are invalid
With Workbooks(sBook)
FirstSheet = .Worksheets(Sheet1).Index
LastSheet = .Worksheets(Sheet2).Index
'swap if out of order
If FirstSheet > LastSheet Then
i = FirstSheet
FirstSheet = LastSheet
LastSheet = i
End If
i = .Worksheets.Count
If FirstSheet >= 1 And LastSheet <= i Then
Parse3DRange = True
End If
End With
Parse3DRangeError:
On Error GoTo 0
Exit Function
End Function 'Parse3DRange