User Defined Function returning #Value!

  • Thread starter Thread starter DogLover
  • Start date Start date
D

DogLover

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?
 
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
 
You will have to remove all msgboxs and the lines which assign a
value/formula to a range ...which will not work when you try this as a
UDF....With UDF you can pass arguments and return a value..

If this post helps click Yes
 
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
 
Back
Top