Never use Activecell, it points at the activesheet, use

Application.Caller.Formula

Why do you need this UDF, couldn't it be done by formulae?

--
__________________________________
HTH

Bob

"Cresta" wrote in message
...
Public Function Sum2DProduct(Header1Range As Range, _
Header1Criteria As Range, _
Column1Range As Range, _
Column1Criteria As Range, _
DataRange As Range, _
Optional Header2Range As Variant, _
Optional Header2Criteria As Variant, _
Optional Header3Range As Variant, _
Optional Header3Criteria As Variant, _
Optional Column2Range As Variant, _
Optional Column2Criteria As Variant, _
Optional Column3Range As Variant, _
Optional Column3Criteria As Variant) As Double
'---
Dim aHeaderCell As Range
Dim aColumn1Cell As Range, aColumn2Cell As Range, aColumn3Cell As Range
Dim cCount As Integer, rCount As Integer
Dim result As Variant
Dim DataSheetVal As String
Dim DataRangeTopRow As Integer, DataRangeBotRow As Integer
Dim H1Match As Boolean, H2Match As Boolean, H3Match As Boolean,
Continue
As Boolean
'---
dd$ = ActiveCell.Formula
For i% = 1 To Len(dd$)
If Mid(dd$, i%, 1) = "[" Then
dd1% = i% + 1

End If
If Mid(dd$, i%, 1) = "]" Then
dd2% = i%
tempstring = Mid(dd$, dd1%, dd2% - dd1%)
Exit For
End If
Next
result = 0
Continue = False
For Each aHeaderCell In Header1Range.Cells
If aHeaderCell.Value = Header1Criteria.Value Then
H1Match = True
cCount = aHeaderCell.Column
If IsMissing(Header2Range) = False Then
If Header2Criteria.Value < "" Then
If Header2Range.Cells(1, cCount).Value =
Header2Criteria.Value Then
H2Match = True
Else
H2Match = False
End If
Else
H2Match = True
End If
Else
H2Match = True
End If
If IsMissing(Header3Range) = False Then
If Header3Criteria.Value < "" Then
If Header3Range.Cells(1, cCount).Value =
Header3Criteria.Value Then
H3Match = True
Else
H3Match = False
End If
Else
H3Match = True
End If
Else
H3Match = True
End If
Else
H1Match = False
End If
If H1Match = True Then
If H2Match = True Then
If H3Match = True Then
Continue = True
Exit For
End If
End If
End If

Next
On Error GoTo errhelp:
If Continue = False Then
Sum2DProduct = 0
Exit Function
Else
DataRangeTopRow = DataRange.Row
DataRangeBotRow = DataRange.Rows.Count - 1 + DataRangeTopRow
DataSheetVal = DataRange.Worksheet.Name

C1TopRow = Column1Range.Row
C1BotRow = Column1Range.Rows.Count - 1 + C1TopRow
C1Column = Column1Range.Column
C1SheetVal = Column1Range.Worksheet.Name


If IsMissing(Column1Criteria) Then cr1 = True
If IsMissing(Column2Criteria) Then cr2 = True
If IsMissing(Column3Criteria) Then cr3 = True

If cr1 = True Then result = 0
If cr1 = False And cr2 = True And cr3 = False Then
result =
WorksheetFunction.SumIfs(Workbooks(tempstring).She ets(DataSheetVal).Range(Range(Cells(DataRangeTopRo w,
cCount), Cells(DataRangeBotRow, cCount)).Address), Column1Range,
Column1Criteria, Column3Range, Column3Criteria)
End If
If cr1 = False And cr2 = False And cr3 = False Then
result =
WorksheetFunction.SumIfs(Workbooks(tempstring).She ets(DataSheetVal).Range(Range(Cells(DataRangeTopRo w,
cCount), Cells(DataRangeBotRow, cCount)).Address), Column1Range,
Column1Criteria, Column2Range, Column2Criteria, Column3Range,
Column3Criteria)
End If
If cr1 = False And cr2 = False And cr3 = True Then
result =
WorksheetFunction.SumIfs(Workbooks(tempstring).She ets(DataSheetVal).Range(Range(Cells(DataRangeTopRo w,
cCount), Cells(DataRangeBotRow, cCount)).Address), Column1Range,
Column1Criteria, Column2Range, Column2Criteria)
End If
If cr1 = False And cr2 = True And cr3 = True Then
Workbooks(tempstring).Activate
result =
WorksheetFunction.SumIfs(Workbooks(tempstring).She ets(DataSheetVal).Range(Range(Cells(DataRangeTopRo w,
cCount), Cells(DataRangeBotRow, cCount)).Address),
Sheets(C1SheetVal).Range(Range(Cells(DataRangeTopR ow, C1Column),
Cells(DataRangeBotRow, C1Column)).Address), Column1Criteria)
End If
Sum2DProduct = result
End If

Exit Function
errhelp:
If Err.Number = 9 Then
Else
MsgBox Err.Number & " " & Err.Description
End If
End Function




Hope this helps

"royUK" wrote:


What's the code in the custom function?


--
royUK

Hope that helps, RoyUK
For tips & examples visit my 'web site' (http://www.excel-it.com/)
------------------------------------------------------------------------
royUK's Profile: http://www.thecodecage.com/forumz/member.php?userid=15
View this thread:
http://www.thecodecage.com/forumz/sh...ad.php?t=47040