I have developed a VBA application in MS Project to measure the quality of a project schedule. My app analyzes every task in a schedule and determines 35 different attributes which are then combined in various ways to compute 13 different quality scores. The program works great and produces the correct results, but I want to consolidate the code in various functions so it is not verbose (e.g., eliminate the Select Case statements). Details are as follows:
Public Const NoAnalItems As Integer = 35 ' Number of analysis items
'
' Define SA_Array and declare SCHED_ANAL
'
Public Type SA_Array ' SA = Schedule Analysis
Item As String ' Name of the analysis item
SAT As Single ' Number of tasks for the entire schedule
SOT As Single ' Number of open tasks
PAT As Single ' Number of tasks for the entered period
POT As Single ' Number of open tasks for the entered period
WT As Integer ' Quality score weight
Category As String ' Category of the analysis item
Description As String ' Decription of the item for display on the help screen
Risk As String ' Risk associated with the item for display on the help screen
ExecuteCheckbox As CheckBox ' Pointer to associated analysis item checkbox; TRUE if executed, FALSE if not
RepairButton As CommandButton ' Pointer to associated analysis item repair button
End Type
Public SCHED_ANAL(NoAnalItems) As SA_Array
Function qsM(stype)
'
' Title: qsM
' Author: 11/21/2023 by Gary E. Didio
' Purpose: Returns the milestone tasks quality score
' stype is the type of task (all, open, period all, or period open)
'
On Error Resume Next
Dim qs, qa, qw As Single
qs = 0
Dim t As SA_Array
Select Case stype
Case "SAT": qa = (SCHED_ANAL(pMDurn).SAT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).SAT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).SAT * SCHED_ANAL(pMPred).WT)
If (SCHED_ANAL(pMTotl).SAT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).SAT
Case "SOT": qa = (SCHED_ANAL(pMDurn).SOT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).SOT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).SOT * SCHED_ANAL(pMPred).WT)
If (SCHED_ANAL(pMTotl).SOT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).SOT
Case "PAT": qa = (SCHED_ANAL(pMDurn).PAT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).PAT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).PAT * SCHED_ANAL(pMPred).WT)
If (SCHED_ANAL(pMTotl).PAT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).PAT
Case "POT": qa = (SCHED_ANAL(pMDurn).POT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).POT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).POT * SCHED_ANAL(pMPred).WT)
If (SCHED_ANAL(pMTotl).POT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).POT
End Select
qw = SCHED_ANAL(pMDurn).WT + SCHED_ANAL(pMFixd).WT + SCHED_ANAL(pMPred).WT
qs = (1 - qa / qw) * 100
qsM = Format(qs, "#0.0")
End Function
I tried using the CallByName function, but do not believe it is appropriate for data structures. At a loss on what else to try.
To reduce the number of the Select Case stype... statements, factor that out into its own function "TaskCount" which takes two arguments: 1) the index of the array, 2) the name of the group of tasks.
Public Const NoAnalItems As Integer = 35 ' Number of analysis items
Public Type SA_Array ' SA = Schedule Analysis
Item As String ' Name of the analysis item
SAT As Long ' whole schedule, all task count
SOT As Long ' whole schedule, open task count
PAT As Long ' period, all task count
POT As Long ' period, open task count
WT As Integer ' Quality score weight
Category As String ' Category of the analysis item
Description As String ' Decription of the item for display on the help screen
Risk As String ' Risk associated with the item for display on the help screen
ExecuteCheckbox As CheckBox ' Pointer to associated analysis item checkbox; TRUE if executed, FALSE if not
RepairButton As CommandButton ' Pointer to associated analysis item repair button
End Type
Public SCHED_ANAL(NoAnalItems) As SA_Array
Function TaskCount(idx As Integer, sType As String) As Long
Select Case sType
Case Is = "SAT": TaskCount = SCHED_ANAL(idx).SAT
Case Is = "SOT": TaskCount = SCHED_ANAL(idx).SOT
Case Is = "PAT": TaskCount = SCHED_ANAL(idx).PAT
Case Is = "POT": TaskCount = SCHED_ANAL(idx).POT
End Select
End Function
Function qsM(sType As String) As String
On Error Resume Next
Dim NumTasks As Long
NumTasks = TaskCount(pMDurn, sType)
Dim qa As Single
qa = (NumTasks * SCHED_ANAL(pMDurn).WT) + (NumTasks * SCHED_ANAL(pMFixd).WT) + (NumTasks * SCHED_ANAL(pMPred).WT)
If NumTasks <> 0 Then
qa = qa / NumTasks
End If
Dim qw As Single
qw = SCHED_ANAL(pMDurn).WT + SCHED_ANAL(pMFixd).WT + SCHED_ANAL(pMPred).WT
Dim qs As Single
qs = (1 - qa / qw) * 100
qsM = Format(qs, "#0.0")
End Function
Note: When declared like this: Dim qs, qa, qw As Single, only qw is declared as Single which initialize as 0, the rest are variants which initialize as Empty. Declare each variable on its own line to avoid erroneous declarations as Variant.
PS This could also be done with a class module instead of the custom Type which would allow a construct such as SCHED_ANAL(pMDurn).TaskCount(sType). However, the overhead required for that single construct would be too much. Keep an eye out, however, for other parts of the code that would work better with SCHED_ANAL as a class which could tip the scales.