Is it possible to pass a 3D formula to a UDF?

You can also simplify string manipulation by using your own string symbols like

=myFunction("Sheet2#Sheet9!B5:F10")

Dave,
You will need to make your UDF volatile by using a statement like:
Application.Volatile

You may also want to pass the range reference in two pieces: a range reference to the beginning sheet that defines the range and first worksheet, and a range reference to the last sheet. The advantage of doing so is that the range references pick up any changes in worksheet name.

These type of functions were developed (in VBA) by David Hager back in the Nineties: http://spreadsheetpage.com/index.php/site/eee/issue_no_3_april_15_1999/   Issue number 3 gives a good introduction, but other issues (there are 20) show other examples.

Brad

I was hoping not to have to put the quotations around the 3d range.  The question is around whether I can do that or not.

Dave

Dave,
I was able to create a function like the following and get it to return a value when passing a 3D range:

Function MySum(rg)
MySum = VarType(rg)
End Function

Select allOpen in new window

Unfortunately, the value returned is a 10, which means that rg is an error value.

AFAIK, you cannot pass a 3D range into a UDF and do anything useful with it. That's why all the workarounds posted over the years have passed the range as a string or as two ranges (one for beginning and the other for the end).

Brad

About the only use I came up with for the 3D range being passed is that it triggers recalculation of the UDF precisely when necessary. In other words, you wouldn't need to include Application.Volatile in the UDF to force recalculation.

=MySum("Sheet1:Sheet3!A1:A10",Sheet1:Sheet3!A1:A10)

Function MySum(rg As String, rgDummy)
Dim iFirst As Integer, iLast As Integer, j As Integer
Dim sRange As String, sSheets As String
j = InStr(1, rg, "!")
sSheets = Left(rg, j - 1)
sRange = Mid(rg, j + 1)
If Left(sSheets, 1) = "'" Then sSheets = Mid(sSheets, 2, Len(sSheets) - 2)
iFirst = Worksheets(Split(sSheets, ":")(0)).Index
iLast = Worksheets(Split(sSheets, ":")(1)).Index
For j = iFirst To iLast
    MySum = MySum + Application.Sum(Worksheets(j).Range(sRange))
Next
End Function

Select allOpen in new window

Dave,
You may not like it, but here is a workaround that allows you to write a UDF that accepts a 3D range as its parameter--and which calculates a result. You can use it with a worksheet formula like:
=Test(Sheet1:Sheet3!A1:A10)

Function Test(rg)
Dim cel As Range
Dim frmla As String, sSheets As String, sRange As String
Dim iFirst As Integer, iLast As Integer, j As Integer
Set cel = Application.Caller
frmla = cel.Formula
frmla = Mid(frmla, InStr(1, frmla, "(") + 1)
frmla = Split(Split(frmla, ",")(0), ")")(0)     'First parameter--eliminate both commas and right parenthesis
j = InStr(1, frmla, "!")
sSheets = Left(frmla, j - 1)
sRange = Mid(frmla, j + 1)
If Left(sSheets, 1) = "'" Then sSheets = Mid(sSheets, 2, Len(sSheets) - 2)
iFirst = Worksheets(Split(sSheets, ":")(0)).Index
iLast = Worksheets(Split(sSheets, ":")(1)).Index
For j = iFirst To iLast
    Test = Test + Application.Sum(Worksheets(j).Range(sRange))
Next
End Function

Select allOpen in new window

The trick of the code is that it never uses the parameter rg for anything. Instead, it uses Application.Caller to return the cell calling the UDF, then parses the formula in that cell to capture the 3D range as text. It then performs operations on that 3D range (in the sample code it is adding up the values).

Even though rg is not used in the UDF, like any dummy parameter it triggers a recalc whenever it something is changed in the 3D range it describes. The recalc is not triggered when you manipulate the value of cells outside the 3D range.

Because this was a proof of concept, I didn't bother to make the formula parser robust at all. It looks for a left parenthesis and then assumes the parameter(s) lie to the right. It then looks for a right parenthesis or comma as the terminator. The desired parameter is the very first one. If you are intrigued by the workaround, you'll need to make this part of the code much more robust.

Brad

Well, parsing the formula need not be much more sophsticated than parsing a string representing the 3D range as the first function parameter, whilst the remaining parameters can be pulled thru the function as normal.  I just wanted to create a set of 3D functions as part of my learning process via a VSTO or Automation add-in where the user didn't have to specify the 3D range as a string.  I also wanted to see how much faster compiled code was than the VBA for functions like CountIF3D.  My interest was peaked when I found that folks were having trouble getting the MOREFUNC CountIF3D and THREED functions to work/work properly in later versions of Office.

When I feel like spending time geeking out on my computer (hopefully in the next day or two) I'll give your proposed solution (looks like a winner) a whirl.

PS - I wasn't clear enough in my OP to say that I was well aware of the old VBA functions, passing the parameters as string - something I wanted to avoid, to gain the benefit of dragging the formula around, etc., (without using indirect, etc.)  As a result, I'll award some points to ssaqibh as well.

Cheers & Happy New Year,

Dave

I rewrote the parsing to be somewhat more robust. I also put it in a separate function so you could concentrate on the calculation logic in each of the supporting routines. This function is passed the cell containing the formula, the function name and the index of the parameter being sought. It returns the workbook name, first sheet name, last sheet name and range address, all as strings.

The revised code works on 3D ranges in the same workbook or a different one. It also works on 2D ranges.

Using this approach, it should be very easy to simulate all the usual suspects.


As best I can find, nobody besides Microsoft has gotten 3D ranges to work in VBA functions in their native form--though many have tried. This effort ought to make an excellent article.

Function Sum3D(rg)
Dim cel As Range
Dim iFirst As Integer, iLast As Integer, j As Integer
Dim v As Variant
Dim wb As Workbook
If VarType(rg) = 10 Then
    On Error Resume Next
    Set cel = Application.Caller
    On Error GoTo 0
    If cel Is Nothing Then
        Sum3D = "#NoRange"
        Exit Function
    End If
    
    v = Parse3D(cel, "Sum3D", 1)
    Set wb = Workbooks(v(0))
    iFirst = wb.Worksheets(v(1)).Index
    iLast = wb.Worksheets(v(2)).Index
    For j = iFirst To iLast
        Sum3D = Sum3D + Application.Sum(wb.Worksheets(j).Range(v(3)))
    Next
Else
    Sum3D = Application.Sum(rg)
End If
End Function

Function Parse3D(FormulaCell As Range, fnName As String, parmIndex As Integer) As Variant
'Parses a formula looking for a specified function. If found, returns a variant array containing four strings: _
    workbook name, first worksheet name, last worksheet name and range address
Dim j As Integer, k As Integer
Dim firstSheet As String, frmla As String, lastSheet As String, sSheets As String, sRange As String, sWorkbook As String
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
frmla = FormulaCell.Formula
j = InStr(1, UCase(frmla), UCase(fnName) & "(")
If j > 0 Then
    sSheets = Mid(frmla, j + Len(fnName) + 1)
    sSheets = Split(sSheets, ",")(parmIndex - 1)
    If Right(sSheets, 1) = ")" Then sSheets = Left(sSheets, Len(sSheets) - 1)
    k = InStr(1, sSheets, "!")
    If k = 0 Then
        sRange = sSheets
        firstSheet = cel.Worksheet.Name
        lastSheet = cel.Worksheet.Name
    Else
        sRange = Split(sSheets, "!")(1)
        sSheets = Split(sSheets, "!")(0)
        k = InStr(1, sSheets, "]")
        If k > 0 Then
            sWorkbook = Split(sSheets, "]")(0)
            If Left(sWorkbook, 1) = "'" Then sWorkbook = Mid(sWorkbook, 2)
            If Left(sWorkbook, 1) = "[" Then sWorkbook = Mid(sWorkbook, 2)
            sSheets = Split(sSheets, "]")(1)
        End If
        If Left(sSheets, 1) = "'" Then sSheets = Mid(sSheets, 2)
        If Right(sSheets, 1) = "'" Then sSheets = Left(sSheets, Len(sSheets) - 1)
        k = InStr(1, sSheets, ":")
        If k = 0 Then
            firstSheet = sSheets
            lastSheet = sSheets
        Else
            firstSheet = Split(sSheets, ":")(0)
            lastSheet = Split(sSheets, ":")(1)
        End If
    End If
    If sWorkbook = "" Then sWorkbook = FormulaCell.Worksheet.Parent.Name
    Parse3D = Array(sWorkbook, firstSheet, lastSheet, sRange)
End If
End Function

Select allOpen in new window

@ Brad

The function needs to be more robust. If the sheet  has ! (Exclamation mark) or ' (Apostrophe) in its name, the formula won't work.

Kris

Sorry I hadn't closed this sooner - been pretty sick this past week.