As you may know, MS Project may occasionally behave divaesque. To make matters worse, older versions (like the one, I’m using) know only one (!) undo step. In order to check if some of my changes have screwed up actual work of the past, I dump all actual work from project start to project finish into an Excel file and analyze it with a pivot table. I can now easily compare actual work before and after I’ve made changes to the project.

The following picture shows the resulting pivot table with resources and actual work by calendar week.

Resulting pivot table from dump

Here is the code. You may want to change the highlighted line to suit your needs. If you don’t want to create the pivot table manually, check out how to automagically create pivot tables.

Option Explicit
Sub swaDumpActualWork2File()
    Dim r As Resource
    Dim tsv As TimeScaleValue
    Dim tsvs As TimeScaleValues
    Dim line As Integer
    Dim tempfilename As String
    Dim excelApp As Object, swaWorkbook As Object
    Dim StartTime As Double
    Dim swaWorksheet As Worksheet

    tempfilename = "C:\GM_Reporting-edta-new\zOld\aaa" & Format(Date, "yyyy-mm-dd--") & Format(Time, "hh-mm-ss") & ".xls"
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = False
    Set swaWorkbook = excelApp.Workbooks.Add
    Set swaWorksheet = excelApp.Worksheets(1) ' work with first worksheet

    ' write header: name, date, actual work in hours, ...
    swaWorksheet.Cells(1, 1) = "Name"
    swaWorksheet.Cells(1, 2) = "Date"
    swaWorksheet.Cells(1, 3) = "Hours"
    swaWorksheet.Cells(1, 4) = "swaKW"
    swaWorksheet.Cells(1, 5) = "Year"
    swaWorksheet.Cells(1, 6) = "Month"

    StartTime = Timer

    line = 1
    For Each r In ActiveProject.Resources
        Set tsvs = r.TimeScaleData(StartDate:=ActiveProject.ProjectStart, EndDate:=ActiveProject.ProjectFinish, Type:=pjResourceTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays, Count:=1)
        For Each tsv In tsvs
            If Val(tsv.Value) > 0 Then
                line = line + 1
                ' Debug.Print Format(w, "000") & " " & tsv.StartDate & " " & Val(tsv.Value) / 60 & "h"
                swaWorksheet.Cells(line, 1) = r.Name
                swaWorksheet.Cells(line, 2) = tsv.StartDate
                swaWorksheet.Cells(line, 3) = Val(tsv.Value) / 60 ' assuming
                swaWorksheet.Cells(line, 4).Formula = "=CONCATENATE(YEAR(B" + Format(line) + "),""-"",TEXT(INT((B" + Format(line) + "-DATE(YEAR(B" + Format(line) + "-WEEKDAY(B" + Format(line) + "-1)+4),1,3)+WEEKDAY(DATE(YEAR(B" + Format(line) + "-WEEKDAY(B" + Format(line) + "-1)+4),1,3))+5)/7),""00""))"
                swaWorksheet.Cells(line, 5).Formula = "=year(B" + Format(line) + ")"
                swaWorksheet.Cells(line, 6).Formula = "=month(B" + Format(line) + ")"
            End If
        Next tsv
    Next r

    Debug.Print Format(Timer - StartTime, "00.00") & " seconds"

    swaWorkbook.SaveAs tempfilename
    swaWorkbook.Close (True)
    excelApp.Quit

End Sub