I've been going through the sample data and the equation for the field 'Duration' seems to call a function 'WorkTime'. I'm not seeing this function in the VB Editor?
Also, when I try and create a hierarchy equation with one of my number fields, I get an error message telling me, 'Error calculating function SUM. Verify that the function exists for field PlaceHolder". My VB Editor does not have any code for a SUM function, but the part on hierarchy equations in section 4.042 of the manual, says that Sum is one of a few basic functions for that is already included. I'm comparing my hierarchy equation to the ones in the sample data that use SUM, like 'Actual$', and I don't see any difference. What am I missing?
Comments
'-------------------------------------------
Function WorkTime(d1, d2, HrsPerDay) ' d2 is the later date. Handles multi-day tasks
dim diff, days, hrs
if isnull(d1) then exit function
if isnull(d2) then exit function
d1=cdate(d1): d2=cdate(d2)
diff=d2-d1
if diff>=1 then
days=datediff("d",d1,d2)
WorkTime=days*HrsPerDay
end if
Hrs=(diff-int(diff))*24
WorkTime=WorkTime+Hrs
workTime=formatnumber(workTime,2)
end function
'--------------------------------------------
Function NZ(x) ' converts Nulls to zero
if isNull(x) then NZ=0 else NZ=x
end function
'-------------------------------------------
Function ZN(x) ' converts zero to Nulls
if x=0 then ZN=null else ZN=x
end function
'-------------------------------------------
Function WorkTime(d1, d2, HrsPerDay) ' d2 is the later date. Handles multi-day tasks
dim diff, days, hrs
if isnull(d1) then exit function
if isnull(d2) then exit function
d1=cdate(d1): d2=cdate(d2)
diff=d2-d1
if diff>=1 then
days=datediff("d",d1,d2)
WorkTime=days*HrsPerDay
end if
Hrs=(diff-int(diff))*24
WorkTime=WorkTime+Hrs
workTime=formatnumber(workTime,2)
end function
public Function SetFontAttrib(ItemFont,Attrib,Value)
dim i, s, s2
if isnull(ItemFont) then ItemFont="|"
s2="|" & Attrib & "|"
i=instr(itemfont,s2)
if i=0 and value=-1 then
s=itemfont & s2
elseif i>0 and value=0 then s=replace(itemfont,s2,"")
end if
if s="|" then s=""
SetFontAttrib=s
end Function
'-------------------------------------------
Function IIF(Condition,T,F) ' Immediate IF as in some other languages. If true returns first variable, false returns the second
if Condition=true then IIF=T else IIF=F
end function
'-------------------------------------------
Function CalcEndDate(StartDate, Duration, NonBillable) ' calculates the end time of a task, given a start, duration and nonBillable
if isnull(StartDate) then exit function
CalcEndDate=cdate( StartDate ) + ( Duration + NonBillable ) /24
end Function
'-------------------------------------------
Function RoundedTime(StartDate) ' round the supplied time to the earliest hour or half hour
RoundedTime = Int(StartDate * 48) / 48
End Function
'-------------------------------------------
Function CalcUrgency(Due, Duration, PDone, Done) ' calculates an Urgency figure for tasks >0=late or will be late based on Duration and PercentDone
if isnull(Done) and not isnull( Due ) then
CalcUrgency = int( int(now) - int(cdate( nz( due ) )) + (nz(Duration) * (100-nz(PDone))/100 * 7/5) )
if CalcUrgency<-60 then CalcUrgency=null
else
CalcUrgency = null
end if
End Function
Function CalcColor(Urgency) ' calculation of the itemcolor color code based on the Urgency level
if isnull(Urgency) then
CalcColor = ""
else
if Urgency < -10 then
CalcColor=""
elseif Urgency <=-3 then CalcColor="Yellow"
elseif Urgency < 0 then CalcColor="Blue"
elseif Urgency <=5 then CalcColor="Purple"
else CalcColor="Red"
end if
end if
End Function
' The following functions can be used in Hierarchy calculations. Typically: parent = sum (children)
'-------------------------------------------
Function Sum(x) ' Calculates the sum of the array x
dim d, i
d=ubound(x)
for i=0 to d
Sum=Sum+NZ(x(i))
next
end Function
function Testzero(t)
testzero = 0 / 0
end function
'-------------------------------------------
Function Max(x) ' calculates the max of the array x
dim d, i
d=ubound(x)
for i=0 to d
if not isnull(x(i)) then
if i=0 or x(i)>Max then Max=x(i)
end if
next
end Function
'-------------------------------------------
Function Min(x) ' calculates the min of the array x
dim d, i
d=ubound(x)
for i=0 to d
if not isnull(x(i)) then
if i=0 or x(i)<Min then Min=x(i)
end if
next
end Function
'-------------------------------------------
Function AVG(x) ' calculates the average of the array x
dim d
d=ubound(x)
AVG=SUM(x)/(d+1)
End Function
'-------------------------------------------
Function First(x) ' returns the first element of array x
First=x(0)
end Function
Function PickFirst(x1, x2, x3, x4) ' picks the first not null, not zero in the list.
dim v
if not isnull(x1) and x1<>0 then
v=x1
elseif not isnull(x2) and x2<>0 then v=x2
elseif not isnull(x3) and x3<>0 then v=x3
else v=x4
end if
PickFirst=v
end Function
Function NumPart(x) ' if a text field contains a number followed by a text note (i.e. 3.2 special case), returns the numeric part
dim v, y, i
x=trim(x)
if x="" or isnull(x) then NumPart=null: exit function
y = split(x," ")
for i = lbound(y) to ubound(y)
if isNumeric(y(i)) then
v = v & y(i)
else
if i=lbound(y) then v=x
exit for
end if
next
If Not IsNumeric(v) Then NumPart = Null Else NumPart = CDbl(v)
End Function
'--------------------------------------------
Function TextPart(x) ' if a text field contains a number followed by a text note (i.e. 3.2 special case), returns the text part
dim y, i, OK, v
OK=FALSE
x=trim(x)
y = split(x," ")
for i = lbound(y) to ubound(y)
if not isNumeric(y(i)) OR OK=TRUE then v=v & y(i) & " ": OK=TRUE
next
TextPart=trim(v)
End Function
Function PV(IntRate, NbPeriods, FV)
dim IR
IR=IntRate
if IR>0.5 then IR=IR/100 ' handle if rate is entered as 8 for 8% (as opposed to 0.08)
PV=FV/((1+IR)^NbPeriods)
End Function
Function FV(IntRate, NbPeriods, PV)
dim IR
IR=IntRate
if IR>0.5 then IR=IR/100 ' handle if rate is entered as 8 for 8% (as opposed to 0.08)
FV=PV*(1+IR)^NbPeriods
End Function
'-------------------------------------------
Function DayPart()
dim d
d=now-date
if d>=0.3333 and d<0.5833 then
DayPart="Morning"
elseif d< 0.70833 then
DayPart="Afternoon"
elseif d < 0.95833 then
DayPart="Evening"
else
DayPart="Night"
end if
End Function
Function Today
Today=date
End Function
Function GetFile()
GetFile=inputbox("Enter filename", "File requested...")
End Function
Function HasKeyword(Fi, keyw, CaseSpecific)
dim myFi, CompareMethod
HasKeyword=0
if CaseSpecific=true then CompareMethod=1 else CompareMethod=0
myFi=trim(Fi & "")
if instr(1,myFi,keyw,CompareMethod)>0 then HasKeyword=true
End Function
Function AddKeyword(Fi, keyw)
dim myFi
myFi=trim(Fi & "")
if instr(myFi,keyw)=0 then
if len(myFi)>0 then myFi = myFi & " "
myFi=MyFi & keyw
End if
if myFi="" then myFi=null
AddKeyword=myFi
End Function
Function RemoveKeyword(Fi, keyw)
dim myFi
myFi=replace(Fi & "",keyw,"")
myFi=replace(myFi,",,","")
if trim(myFi)="" then myFi=null
RemoveKeyword=myFi
End Function
function test(aString)
if aString= "a" then
test=1
else
test=2
end if
end function
Function GetFile(InitialFile)
dim dialog
set dialog = CreateObject("MSComDlg.CommonDialog")
dialog.Filter = "All files (*.*)|*.*| "
Dialog.FileName=InitialFile & ""
dialog.MaxFileSize = 260
' dialog.ShowOpen()
intResult = Dialog.ShowOpen
' If intResult <> 0 Then
GetFile = Dialog.FileName
' else: GetFile=InitialFile
' End If
' Set objDialog = CreateObject("MsComDlg.CommonDialog")
' objDialog.Filter = "All Files|*.*|Text Files|*.TXT"
' objDialog.FilterIndex = 1
' objDialog.FileName=InitialFile & ""
' intResult = objDialog.ShowOpen
' If intResult <> 0 Then
' GetFilePath = objDialog.FileName
' else: GetFilePath=InitialFile
' End If
End Function
function calcTime(DayPart)
select case DayPart
case "Morning"
calcTime= "2 PM"
case "Afternoon"
CalcTime= "5 PM"
case "Evening"
CalcTime= "11 PM"
case "Night"
CalcTime= "6 AM"
Case Else
calcTime= "0 AM"
end select
end function
Function ShowMessage(s)
msgbox s
end Function
Function RegExp(p, s)
dim r, v, v2
set r = new RegExp
r.IgnoreCase = True
r.Global = True
r.Pattern = p
set v = r.Execute(s)
if v.Count > 0 then
set v2=v(0)
RegExp = v2.Value
end if
End Function
Function GetDomainName(s)
dim v, p
s=trim(ucase(s))
if left(s,7)<>"HTTP://" then s="HTTP://" & s
p="http://[^/]*/"
v = RegExp(p,s)
GetDomainName = v
End Function
FUNCTION CalcGPA(Grade, Units)
dim t
SELECT case Grade
case "A": t=4.0
case "A-": t=3.7
case "B+": t=3.3
case "B": t=3.0
case "B-": t=2.7
case "C+": t=2.3
case "C": t=2.0
case "C-": t=1.7
case "D+": t=1.3
case "D": t=1.0
case "D-": t=0.7
case "F", "P": t=0.0
end SELECT
CalcGPA = t * Units
if isnull(Grade) or grade="" then CalcGPA=null
End FUNCTION
Function CalcGPAAVG(GPA,NbUnits, Grade)
dim t
select case Grade
case "P": t=0
case else
if NbUnits>0 then t=GPA/NbUnits else t=0
end select
CalcGPAAVG=t
End Function
Function WhoColor(Who) ' calculation of the itemcolor color code based on the Who assignment
dim s: s=ucase(Who)
if isnull(s) or s="" then
WhoColor=""
else
select case s
case "WH" : WhoColor="Yellow"
case "JD" : WhoColor="Blue"
case "RR" : WhoColor="Purple"
case else : WhoColor="Red"
end select
end if
End Function
'----------------------------------------
Function Catenate(FirstString, SecondString, FormatString)
' FormatString can be: "<Second>, <First>"
dim sF, sL, sFor, sOut
sF=FirstString & "": sL=SecondString & "": sFor=FormatString & ""
if sF="" then
sOut=sL
elseif sL="" then sOut=sF
else
sOut=sFor
sOut=replace(sOut,"<First>",sF)
sOut=replace(sOut, "<Second>",sL)
end if
Catenate=sOut
End Function
'-------------------------------------------
Function ColorFromVehicule(IDVehicule)
dim c
select case IDVehicule
case "Echo1": c=&hffDDDD
case "Echo2": c=&hDDffDD
case "Prius1": c=&hDDDDff
end select
ColorFromVehicule=c
End Function
Function CalcBestPlayer(Basketball, Charley, Bob, Joe, Ken, Mary, Pierre)
dim v, v2
if isnull( Basketball ) then
v=Charley
if Bob>v then v=bob
if Joe>v then v=Joe
if Ken>v then v=ken
if Mary>v then v=Mary
if Pierre>v then v=Pierre
if Charley = v then v2 = "Charley "
if Bob = v then v2 = v2 & "Bob "
if Joe = v then v2 = v2 & "Joe "
if Ken = v then v2 = v2 & "Ken "
if Mary = v then v2 = v2 & "Mary "
if Pierre = v then v2 = v2 & "Pierre"
CalcBestPlayer = v2
end if
End Function