I'm writing an MS Project macro that reads that reads in a .csv file of resource data showing the remaining hours for each resource on each task that they're assigned to, then calculates the start and end date based on the number of hours remaining and updates the timescalevalues for the corresponding task/resource/assignment after some basic calculations on how many days & hours per day to fill for the given number of hours. Start & end date, hours per day and days to fill are calculated differently based on whether the task exists in the project already or needs to be created, and whether the task changes when reading in the sorted data file.
The code works exactly as it should when I test it with one single line item in the date file. Then when I add a second line item to the data file for the same task but different resource, it stores that correctly as well, but it changes the first value on the first resource that was correctly stored.
Project screenshot after running macro with above data
Both data lines had 2 hours, if I run the code with only the first entry, 2 hours is entered but with both it switches to 0.4. If I run it with both and break out of the code while running before it updates for the second line, it has 2 hours.
Sub ImportTimesheetDataProjected()
Dim proj As Project
Set proj = Application.ActiveProject
Set xlApp = New Excel.Application
Dim filePath As Variant
Dim fd As FileDialog
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select data file"
fd.Filters.Clear
fd.Filters.Add "CSV Files", "*.csv", 1
fd.Show
filePath = fd.SelectedItems(1)
If filePath <> "" Then
Application.Calculation = pjManual
Application.ScreenUpdating = False
ReadTimesheetDataAndUpdateProject proj, filePath
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
MsgBox "Timesheet data updated successfully.", vbInformation
Else
MsgBox "No file selected. Operation canceled.", vbInformation
End If
End Sub
Sub ReadTimesheetDataAndUpdateProject(proj As Project, filePath As Variant)
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")
Dim wb As Excel.Workbook
Set wb = excelApp.Workbooks.Open(filePath)
Dim ws As Excel.Worksheet
Set ws = wb.Worksheets(1)
'Time data sorting code omitted
Dim rowIndex As Long
Dim lastRowIndex As Long
lastRowIndex = ws.Cells(ws.Cells.Rows.Count, 1).End(-4162).Row
Dim taskName As String
Dim prevTaskName As String
prevTaskName = ""
Dim task As task
Dim resourceName As String
Dim prevResourceName As String
Dim assignment As assignment
Dim resource As resource
Dim ts As TimeScaleValues
Dim tsIndex As Long
Dim startDate As Date
Dim endDate As Date
Dim found As Boolean
Dim workingDays As Long
Dim totalDays As Long
Dim hoursPerDay As Variant
Dim lastCellFlag As Boolean
rowIndex = 2
Do While rowIndex <= lastRowIndex
taskName = ws.Cells(rowIndex, 2).Value & " - " & ws.Cells(rowIndex, 3).Value & " - " & ws.Cells(rowIndex, 4).Value
resourceName = ws.Cells(rowIndex, 5).Value
If ws.Cells(rowIndex, 6).Value > 0 Then
If taskName <> prevTaskName Then
workingDays = excelApp.WorksheetFunction.RoundUp(ws.Cells(rowIndex, 6).Value / 7.6, 0)
found = Find(Field:="Name", Test:="equals", Value:=taskName)
If found Then
Set task = ActiveCell.task
startDate = Int(proj.StatusDate + 1)
totalDays = getTotalDays(workingDays, startDate)
If startDate + totalDays > task.Finish Then
endDate = startDate + totalDays
task.Finish = endDate
hoursPerDay = 7.6
lastCellFlag = True
Else
endDate = Int(task.Finish)
hoursPerDay = ws.Cells(rowIndex, 6).Value / getWorkingDays(startDate, endDate)
lastCellFlag = False
End If
Else
Set task = proj.Tasks.Add(taskName)
task.Type = pjFixedWork
startDate = Date
task.Start = startDate
totalDays = getTotalDays(workingDays, startDate)
endDate = Date + totalDays
task.Finish = endDate
hoursPerDay = 7.6
lastCellFlag = True
End If
Else
totalDays = getTotalDays(workingDays, startDate)
If startDate + totalDays > task.Finish Then
endDate = Int(startDate + totalDays)
task.Finish = endDate
hoursPerDay = 7.6
lastCellFlag = True
Else
hoursPerDay = ws.Cells(rowIndex, 6).Value / getWorkingDays(startDate, endDate)
lastCellFlag = False
End If
End If
Set resource = FindOrCreateResource(proj, resourceName)
Set assignment = FindOrAddResourceToTask(task, resource)
Set ts = assignment.TimeScaleData(startDate:=startDate, endDate:=endDate, Type:=pjAssignmentTimescaledWork, TimeScaleUnit:=pjTimescaleDays)
tsIndex = 1
Do While tsIndex < ts.Count
If Format(ts(tsIndex).startDate, "ddd") <> "Sat" And Format(ts(tsIndex).startDate, "ddd") <> "Sun" Then
ts(tsIndex).Value = hoursPerDay * 60
End If
tsIndex = tsIndex + 1
Loop
If lastCellFlag Then
ts(tsIndex).Value = (((ws.Cells(rowIndex, 6).Value * 100) Mod 760) / 100) * 60
Else
ts(tsIndex).Value = hoursPerDay * 60
End If
prevTaskName = taskName
End If
rowIndex = rowIndex + 1
Loop
wb.Save
wb.Close
excelApp.Quit
End Sub
Function FindOrCreateResource(proj As Project, resourceName As String) As resource
Dim resource As resource
Dim found As Boolean
For Each res In proj.Resources
If res.Name = resourceName Then
Set resource = res
Exit For
End If
Next res
If resource Is Nothing Then
Set resource = proj.Resources.Add(resourceName)
End If
Set FindOrCreateResource = resource
End Function
Function FindOrAddResourceToTask(task As task, resource As resource) As assignment
For Each assignment In task.Assignments
If assignment.resourceName = resource.Name Then
Set FindOrAddResourceToTask = assignment
Exit Function
End If
Next assignment
Set FindOrAddResourceToTask = task.Assignments.Add(ResourceID:=resource.ID)
End Function
Function getTotalDays(totalDays As Long, startDate As Date) As Long
Dim i As Long
i = 0
Do While i < totalDays
If Format(startDate + i, "ddd") = "Sat" Or Format(startDate + i, "ddd") = "Sun" Then
totalDays = totalDays + 1
End If
i = i + 1
Loop
getTotalDays = totalDays
End Function
Function getWorkingDays(startDate As Date, endDate As Date) As Long
Dim totalDays As Long
Dim workingDays As Long
Dim i As Long
totalDays = DateDiff("d", startDate, endDate)
workingDays = totalDays
i = 0
Do While i < totalDays
If Format(startDate + i, "ddd") = "Sat" Or Format(startDate + i, "ddd") = "Sun" Then
workingDays = workingDays - 1
End If
i = i + 1
Loop
getWorkingDays = workingDays
End Function
The code runs but likely contains some very minor errors in the date and hours calculations that I can't debug until I solve this.
Initially I did tried setting the start and end date for the task and updating the 'RemaingHours' for the assignment directly but I had the same problem with values changing. I'd be happy if I can update the 'Work' with the correct remaining hours for each data line regardless of duration.
Many thanks in advance.
Edited as requested - greatly appreciate your time