3D User Defined Functions

By Myrna Larson and David Hager

Presented below are 3 UDF’s (SumProduct3D, SumIf3D, CountIf3D) that
provide a useful method of returning a variety of information from 3D
ranges. Each of these functions use a 3D range argument (written as per
the usual Excel protocol) as a string. This string is processed by the
Parse3DRange function, which returns sheet positions and the range argument
in variables that are used by these functions.

Function SumProduct3D(Range3D As String, Range_B As Range) _
    As Variant
 
    Dim sRangeA As String
    Dim sRangeB As String
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim Sum As Double
    Dim n As Integer
 
    Application.Volatile
 
    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sRangeA) = False Then
      SumProduct3D = CVErr(xlErrRef)
      Exit Function
    End If
    sRangeB = Range_B.Address
 
    Sum = 0
    For n = Sheet1 To Sheet2
      With Worksheets(n)
        Sum = Sum + Application.WorksheetFunction.SumProduct( _
    .Range(sRangeA), .Range(sRangeB))
      End With
    Next
    SumProduct3D = Sum
  End Function
 
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
 
Function CountIf3D(Range3D As String, Criteria As String) _
    As Variant
 
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim sTestRange As String
    Dim n As Integer
    Dim Count As Long
 
    Application.Volatile
 
    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sTestRange) = False Then
      CountIf3D = CVErr(xlErrRef)
      Exit Function
    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
 
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

Editor’s Note: I didn’t like that the second argument was a range that had to mirror the 3D-ness of the first string-range. I change the parsing function to return an array of ranges so that you could put any two equally sized ranges in as arguments and one, both, or neither have to be 3D. The downside is that both arguments have to be strings.

Function SumProduct3D2(sRng1 As String, sRng2 As String) _
    As Variant
 
    Dim vaRng1 As Variant, vaRng2 As Variant
    Dim rTemp As Range
    Dim i As Long
    Dim Sum As Double
    Dim rCell As Range
   
    Application.Volatile
   
    vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, sRng1)
    vaRng2 = Parse3DRange2(Application.Caller.Parent.Parent, sRng2)
   
    For i = LBound(vaRng1) To UBound(vaRng1)
        Sum = Sum + (vaRng1(i).Value * vaRng2(i).Value)
    Next i
   
    SumProduct3D2 = Sum
   
  End Function
 
Function SumIf3D2(Range3D As String, Criteria As String, _
    Optional Sum_Range As String) As Variant
 
    Dim Sum As Double
    Dim vaRng1 As Variant, vaRng2 As Variant
    Dim i As Long
   
    Application.Volatile
   
    If Len(Sum_Range) = 0 Then
      Sum_Range = Range3D
    End If
 
    vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, Range3D)
    vaRng2 = Parse3DRange2(Application.Caller.Parent.Parent, Sum_Range)
   
    Sum = 0
    For i = LBound(vaRng1) To UBound(vaRng1)
        Sum = Sum + Application.WorksheetFunction.SumIf(vaRng1(i), Criteria, vaRng2(i))
    Next i
   
    SumIf3D2 = Sum
   
End Function
 
Function CountIf3D2(Range3D As String, Criteria As String) _
    As Variant
 
    Dim i As Long
    Dim Count As Long
    Dim vaRng1 As Variant
   
    Application.Volatile
 
    vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, Range3D)
 
    Count = 0
    For i = LBound(vaRng1) To UBound(vaRng1)
        Count = Count + Application.WorksheetFunction.CountIf(vaRng1(i), Criteria)
    Next i
   
    CountIf3D2 = Count
   
End Function
 
Function Parse3DRange2(wb As Workbook, _
                        SheetsAndRange As String) As Variant
 
    Dim sTemp As String
    Dim i As Long, j As Long
    Dim Sheet1 As String, Sheet2 As String
    Dim aRange() As Range
    Dim sRange As String
    Dim lFirstSht As Long, lLastSht As Long
    Dim rCell As Range
    Dim rTemp As Range
   
    On Error GoTo Parse3DRangeError
 
    sTemp = SheetsAndRange
       
    ‘if it’s 3d, rtemp will be nothing
   On Error Resume Next
        Set rTemp = Range(sTemp)
    On Error GoTo Parse3DRangeError
   
    ‘if it’s 3d, parse it
   If rTemp Is Nothing Then
       i = InStr(sTemp, “!”)
       If i = 0 Then Err.Raise 9999
   
       ‘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 wb
           lFirstSht = .Worksheets(Sheet1).Index
           lLastSht = .Worksheets(Sheet2).Index
       
           ‘swap if out of order
          If lFirstSht > lLastSht Then
               i = lFirstSht
               lFirstSht = lLastSht
               lLastSht = i
           End If
             
           ‘load each cell into an array
          j = 0
           For i = lFirstSht To lLastSht
               For Each rCell In .Sheets(i).Range(sRange)
                   ReDim Preserve aRange(0 To j)
                   Set aRange(j) = rCell
                   j = j + 1
               Next rCell
           Next i
       End With
       
       Parse3DRange2 = aRange
    Else
        ‘range isn’t 3d, so just load each cell into array
       For Each rCell In rTemp.Cells
            ReDim Preserve aRange(0 To j)
            Set aRange(j) = rCell
            j = j + 1
        Next rCell
       
        Parse3DRange2 = aRange
    End If
   
Parse3DRangeError:
    On Error GoTo 0
    Exit Function
 
End Function  ‘Parse3DRange
Posted in Uncategorized

11 thoughts on “3D User Defined Functions

  1. I believe I’ve seen an alternative in the newsgroups that uses two range arguments rather than one string argument to specify 3D ranges to udfs. I suppose there’s no practical difference if one uses 3D string references constructed using two or four CELL(“Address”,) calls.

    BTW, aren’t these just a rehash of Larsen/Hagar in http://j-walk.com/ss/excel/eee/eee003.txt ?

  2. I would love to be able to use these – especially the 3D Sumif. But I can’t figure out what to put in what field of the UDF! For example, what do I put in 3DRange? I guess an example would greatly help. Thanks!

  3. I couldn’t get SumIf3D to work, but SumIf3D2 worked fine.

    =SumIf3D2(“Sheet 1:Sheet 2!A2:A11?,”>4?,”Sheet 1:Sheet 2!B2:B11?)

    Note that all are strings, and the sheet references don’t use single quotes even if the sheet names have spaces in them.

    HTH,
    Bernie

  4. This is really cool. Would it be possible to modify these functions to allow them to access a 3D range in an extrenal workbook (instead of the active workbook)? Could an optional argument to specify the workbook be added in the SUMIF3D(2), etc?

    Nicole

  5. I have used Sumif3d2 and it worked great, I wish I could find a way to do the same function except with average. Maybe an Averageif3d????

  6. It’s not working out so well. My Formula I type in is =Sumif3D2("END:START!F5",C8,"END:START!C9")/CountIf3D2("END:START!C9",F5) I get a #DIV/O And if I try Just =Sumif3D2("END:START!F5",C8,"END:START!C9") I get the correct sum value. And if I try =CountIf3D2("END:START!C9",F5) I get 0 and I know thats not correct. Any Suggestions?

Leave a Reply

Your email address will not be published. Required fields are marked *