i've got a problem: When i run this code have "money = 0,00?" for the employes and correct money for the "bosses" of my project:
Sub CalculateBonuses()
Dim BonusFund As Currency
Dim role As Variant
BonusFund = 100000 'example
Const CURATOR_PERC As Double = 0.1
Const CUSTOMER_PERC As Double = 0.1
Const MANAGER_PERC As Double = 0.05
Const PLANNER_PERC As Double = 0.02
Dim TotalPerformerPayment As Currency
TotalPerformerPayment = 0.72 * BonusFund
Dim performers As Object
Set performers = CreateObject("Scripting.Dictionary")
Dim adminRoles As Object
Set adminRoles = CreateObject("Scripting.Dictionary")
adminRoles.Add "Boss 1", 0#
adminRoles.Add "Boss 2", 0#
adminRoles.Add "Boss 3", 0#
adminRoles.Add "Boss 4", 0#
' Step 1
Dim t As Task
Dim SumBaseline As Double
SumBaseline = 0
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
Dim a As Assignment
For Each a In t.Assignments
If IsAdminRole(a.Resource.Name) Then
Else
If t.Baseline1Duration > 0 Then
Debug.Print "Employe: " & a.Resource.Name & _
" | Name: " & t.Name & _
" | Baseline: " & t.Baseline1Duration & _
" | Actual: " & t.ActualDuration
SumBaseline = SumBaseline + t.Baseline1Duration
Else
MsgBox "Error: BaselineDuration = 0 for the task '" & t.Name & "'", vbCritical
End If
End If
Next a
End If
Next t
If SumBaseline = 0 Then
MsgBox "Baseline is 0!", vbCritical
Exit Sub
End If
'Step 2
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
For Each a In t.Assignments
Dim resName As String
resName = a.Resource.Name
If IsAdminRole(resName) Then GoTo SkipPerformer
If Not performers.Exists(resName) Then
performers.Add resName, Array(0#, 0#) ' [Money, remains]
End If
Dim baseline As Double
Dim actual As Double
baseline = t.Baseline1Duration
actual = t.ActualDuration
If actual <= 0 Then actual = baseline
If baseline <= 0 Then baseline = actual
Dim initialPayment As Double
initialPayment = (baseline / SumBaseline) * TotalPerformerPayment
Dim efficiency As Double
efficiency = baseline / actual
Dim payment As Double
payment = initialPayment * efficiency
If payment < 0.2 * initialPayment Then
payment = 0.2 * initialPayment
End If
performers(resName)(0) = performers(resName)(0) + payment
performers(resName)(1) = performers(resName)(1) + (initialPayment - payment)
SkipPerformer:
Next a
End If
Next t
' Step 3
Dim projectStart As Date
Dim projectEnd As Date
projectStart = ActiveProject.projectStart
projectEnd = ActiveProject.ProjectFinish
Dim totalDays As Long
totalDays = DateDiff("d", projectStart, projectEnd)
For Each role In adminRoles.Keys
Dim maxPayment As Currency
Select Case role
Case "Boss 1": maxPayment = CURATOR_PERC * BonusFund
Case "Boss 2": maxPayment = CUSTOMER_PERC * BonusFund
Case "Boss 3": maxPayment = MANAGER_PERC * BonusFund
Case "Boss 4": maxPayment = PLANNER_PERC * BonusFund
End Select
Dim totalRoleDays As Long
totalRoleDays = 0
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
For Each a In t.Assignments
If a.Resource.Name = role Then
totalRoleDays = totalRoleDays + t.ActualDuration
End If
Next a
End If
Next t
Dim calculatedPayment As Currency
calculatedPayment = (totalRoleDays / totalDays) * maxPayment
If calculatedPayment < maxPayment Then
adminRoles(role) = calculatedPayment
Else
adminRoles(role) = maxPayment
End If
Next role
'Step 4
Dim result As String
result = "Result of calculation:" & vbCrLf & vbCrLf
Dim performer As Variant
For Each performer In performers.Keys
result = result & "Employe: " & performer & vbCrLf
result = result & "Money: " & FormatCurrency(performers(performer)(0)) & vbCrLf
result = result & "Remains: " & FormatCurrency(performers(performer)(1)) & vbCrLf & vbCrLf
Next performer
For Each role In adminRoles.Keys
result = result & "Role: " & role & vbCrLf
result = result & "Money: " & FormatCurrency(adminRoles(role)) & vbCrLf
result = result & "Amount: " & FormatCurrency( _
GetAdminMaxPayment(role, BonusFund) - adminRoles(role) _
) & vbCrLf & vbCrLf
Next role
MsgBox result
End Sub
Function GetAdminMaxPayment(ByVal role As String, ByVal BonusFund As Currency) As Currency
Select Case role
Case "Boss 1": GetAdminMaxPayment = 0.1 * BonusFund
Case "Boss 2": GetAdminMaxPayment = 0.1 * BonusFund
Case "Boss 3": GetAdminMaxPayment = 0.05 * BonusFund
Case "Boss 4": GetAdminMaxPayment = 0.02 * BonusFund
End Select
End Function
Function IsAdminRole(roleName As String) As Boolean
Select Case roleName
Case "Boss 1", "Boss 2", "Boss 3", "Boss 4"
IsAdminRole = True
Case Else
IsAdminRole = False
End Select
End Function
Have no idea what's wrong with this code. Could u help me please? In the Immediate console everything's ok, but at the end... "0,00?" Oh God, i saw it in my nightmare yesterday.