As Jacob says: worksheet UDFs will only return values to the calling cell
and are not allowed to change data in other cells.
so remove these lines
'Store the formula on the DATA sheet
.Range("A2").Formula = mFormula
(MsgBox is OK but only for debug purposes)
Also your function will not work properly if any of the referenced
cells/named ranges change unless you make it Volatile by adding
Application.Volatile
For better error handling define the function as Variant rather than Long
and trap and return an error when it occurs
Kountifs=CVErr(XLerrNA)
or whatever error value you think is appropriate.
Charles
___________________________________
The Excel Calculation Site
http://www.decisionmodels.com
"DogLover" wrote in message
...
Here is the UDF code.
Function Kountifs(mPositionC As String) As Long
Dim mTimeCriteria As String
Dim mPositionCriteria As String
Dim mBeginDateCriteria As Variant
Dim mEndDateCriteria As Variant
Dim mStatusCriteria As String
Dim mShiftCriteria As String
Dim mEntityCriteria As String
Dim mDeptNoCriteria As String
Dim mQuestion1Criteria As String
Dim mTimeRange As Range
Dim mPositionRange As Range
Dim mOrientMoYrRange As Range
Dim mStatusRange As Range
Dim mShiftRange As Range
Dim mDeptNoRange As Range
Dim mEntityRange As Range
Dim mQuestion1Range As Range
Dim mFormula As String
Dim mBegMo As Integer, mBegYr As Integer
Dim mEndMo As Integer, mEndYr As Integer
mPositionCriteria = mPositionC ' This line of Code allows automatic
RECALCULATION
'mEntityCriteria = mEntityC
'mBeginDateCriteria = mBeginDateC
'mEndDateCriteria = mEndDateC
'mStatusCriteria = mStatusC
'mShiftCriteria = mShiftC
'mDeptNoCriteria = mDeptNoRC
'MsgBox "Position Reset " & mPositionC
' Needed if Subroutine vs Functio, change to passing variable later
'mPositionCriteria = Worksheets("RFJ").Range("N6")
mEntityCriteria = Worksheets("RFJ").Range("N7")
mBeginDateCriteria = Worksheets("RFJ").Range("N8")
mEndDateCriteria = Worksheets("RFJ").Range("N9")
mStatusCriteria = Worksheets("RFJ").Range("N10")
mShiftCriteria = Worksheets("RFJ").Range("N11")
mDeptNoCriteria = Worksheets("RFJ").Range("N12")
mBegMo = Month(mBeginDateCriteria)
mBegYr = Year(mBeginDateCriteria)
If Month(mEndDateCriteria) = 12 Then
mEndMo = 1
mEndYr = Year(mBeginDateCriteria) + 1
Else
mEndMo = Month(mEndDateCriteria) + 1
mEndYr = Year(mBeginDateCriteria)
End If
' MsgBox "Begin mo " & mBegMo & " Beg year " & mBegYr
' MsgBox "End mo " & mEndMo & " End year " & mEndYr
' Set Criterias
mBeginDateCriteria = "=" & "DATE(" & mBegYr & "," & mBegMo & ",1)"
mEndDateCriteria = "<" & "DATE(" & mEndYr & "," & mEndMo & ",1)"
mTimeCriteria = "=" & Chr(34) & "First day of employment (Time 1)" &
Chr(34)
mQuestion1Criteria = "<" & Chr(34) & "*" & Chr(34)
'Position Criteria
If mPositionCriteria = "<" Then
mPositionCriteria = "<" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mPositionCriteria = "=" & Chr(34) & mPositionCriteria & Chr(34)
End If
'Entity Criteria
If mEntityCriteria = "<" Then
mEntityCriteria = "<" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mEntityCriteria = "=" & Chr(34) & mEntityCriteria & Chr(34)
End If
'Status Criteria
If mStatusCriteria = "<" Then
mStatusCriteria = "<" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mStatusCriteria = "=" & Chr(34) & mStatusCriteria & Chr(34)
End If
'Shift Criteria
If mShiftCriteria = "<" Then
mShiftCriteria = "<" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mShiftCriteria = "=" & Chr(34) & mShiftCriteria & Chr(34)
End If
'Dept No Criteria (NUMERIC FIELD)
If mDeptNoCriteria = "<" Then
mDeptNoCriteria = "=" & 0 ' ALL Records
Else
mDeptNoCriteria = "=" & mDeptNoCriteria
End If
With Worksheets("Data")
Set mTimeRange = .Range("DataTime")
Set mPositionRange = .Range("DataPosition")
Set mOrientMoYrRange = .Range("DataOrientMoYr")
Set mStatusRange = .Range("DataStatus")
Set mShiftRange = .Range("DataShift")
Set mDeptNoRange = .Range("DataDeptNo")
Set mEntityRange = .Range("DataEntity")
Set mQuestion1Range = .Range("DataQuestion1")
mFormula = "=SUMPRODUCT(--(" & mTimeRange.Address & mTimeCriteria & "),"
mFormula = mFormula & "--(" & mPositionRange.Address & mPositionCriteria &
"),"
mFormula = mFormula & "--(" & mOrientMoYrRange.Address &
mBeginDateCriteria
& "),"
mFormula = mFormula & "--(" & mOrientMoYrRange.Address & mEndDateCriteria
&
"),"
mFormula = mFormula & "--(" & mShiftRange.Address & mShiftCriteria & "), "
mFormula = mFormula & "--(" & mStatusRange.Address & mStatusCriteria &
"),"
mFormula = mFormula & "--(" & mEntityRange.Address & mEntityCriteria &
"),"
mFormula = mFormula & "-- (" & mQuestion1Range.Address &
mQuestion1Criteria
& ") )"
'Store the formula on the DATA sheet
.Range("A2").Formula = mFormula
'Evaluate the formula
Kountifs = .Evaluate("A2")
End With
MsgBox Kountifs
If IsError(Kountifs) Then
MsgBox "Error in evaluating"
End If
End Function
"Jacob Skaria" wrote:
Why dont you post the UDF..
If this post helps click Yes
---------------
Jacob Skaria
"DogLover" wrote:
I have a function that I created. When I test it in the Intermediate
Window,
? Kountifs("Registered Nurse"), it returns a 12 which is correct.
I want to be able to use this function a my datasheet. I have included
basically the same function =Kountifs("Registered Nurse"). But, ont
the
datasheet I receive a #Value! rather than the 12.
Does anyone have ideas why?