Project Management | waldherr.org

Not many people on projects typically have MS Project licenses and can read my project plan on their own. Nonetheless everyone has to know what’s going on. Here is a simple macro to export a list of tasks to an Excel spreadsheet for all active resources on the project. You can

exclude resources (see the NoShow list)
customize the target directory (defaultl “C\:temp”)
customize the file names (defaults to Timesheet – <Year> – <Calendar Week> – <Name>

Here is what the resulting files look like. Note that work, actual work and remaining work are displayed in days. The first column contains a field (text28) which I use in MS Project to assign tasks to projects.

All tasks that finish in the current week are highlighted in red, all task that finish in the subsequent week are highlighted in yellow.

If you run the macro twice in one week, you’ll first have to remove the files of the first run.

Caveat: the macro works reliably only if there is at most one resource assigned to a task.

No idea, how to use this code? Check out, how to add VBA code to your computer.


Option Explicit

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

'
' dumps all tasks for all resources into individual excel files
' works only iff there is at most one resource per task
'
Public Sub swaCreateTimeSheets()
    Dim r As Resource
    Dim t As Task
    Dim realname As String
    Dim swaPath As String
    Dim swaPrefix As String
    Dim swaFilename As String
    Dim swaRange As String
    Dim i As Integer

    Dim datTestDate            As Date
    Dim intCalendarWeek        As Integer
    Dim intCalendarWeekFinish  As Integer
    Dim strCalendarWeek        As String

    Dim excelApp As Object, swaWorkbook As Object
    Dim swaWorksheet As Worksheet

    ' list path to files here
    swaPath = "C:\TEMP\" ' must finish with backslash and MUST BE ACCESSIBLE FOR USER (hint C:\ does not work in my case)

    ' prefix for filename
    swaPrefix = "Timesheet"

    ' list here all employees that should not be dumped
    Dim NoShow(17) As String
    NoShow(0) = "Mickey Mouse"
    NoShow(1) = "Donald Duck"
    NoShow(2) = "Joe Schmoe"
    NoShow(3) = "NN"
    NoShow(4) = "NN"
    NoShow(5) = "NN"
    NoShow(6) = "NN"
    NoShow(7) = "NN"
    NoShow(8) = "NN"
    NoShow(9) = "NN"
    NoShow(10) = "NN"
    NoShow(11) = "NN"
    NoShow(12) = "NN"
    NoShow(13) = "NN"
    NoShow(14) = "NN"
    NoShow(15) = "NN"
    NoShow(16) = "NN"

    datTestDate = DateSerial(Year(VBA.Date + (8 - Weekday(VBA.Date)) Mod 7 - 3), 1, 1)
    intCalendarWeek = (VBA.Date - datTestDate - 3 + (Weekday(datTestDate) + 1) Mod 7) \ 7 + 1  'check out the actual calendar week
    If intCalendarWeek < 10 Then
        strCalendarWeek = "0" & CStr(intCalendarWeek)
    Else
        strCalendarWeek = CStr(intCalendarWeek)
    End If

    For Each r In ActiveProject.Resources
        ' skip irregular entries
        If Not (r Is Nothing) Then
            ' skip no-show employees
            If Not IsInArray(r.Name, NoShow) Then
                ' skip resource with zero remaining work
                If r.RemainingWork > 0 Then
                    swaFilename = swaPath + swaPrefix + "-" + CStr(Year(VBA.Date)) + "-" + strCalendarWeek + "-" + r.Name + ".xlsx"
                    ' create the excel file and write header
                    If Not FileExists(swaFilename) Then
                        ' filename is swaPath + year + KW (leading zero) + Name + ".xlsx"
                        '
                        Application.StatusBar = "Dumping " + swaFilename

                        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) = "Project"
                        swaWorksheet.Cells(1, 2) = "Summary Task"
                        swaWorksheet.Cells(1, 3) = "UID"
                        swaWorksheet.Cells(1, 4) = "Name"
                        swaWorksheet.Cells(1, 5) = "Start"
                        swaWorksheet.Cells(1, 6) = "Finish"
                        swaWorksheet.Cells(1, 7) = "Work [d]"
                        swaWorksheet.Cells(1, 8) = "Actual Work [d]"
                        swaWorksheet.Cells(1, 9) = "Remaining Work [d]"

                        swaWorksheet.Rows(1).EntireRow.Font.Bold = True

                        excelApp.ScreenUpdating = False
                        excelApp.Calculation = xlCalculationManual

                        i = 1

                        ' now dump all tasks with remaining work > 0
                        For Each t In ActiveProject.Tasks
                            If InStr(t.ResourceNames, "[") = 0 Then
                                realname = t.ResourceNames
                            Else
                                realname = Left(t.ResourceNames, InStr(t.ResourceNames, "[") - 1)
                            End If
                            If realname = r.Name And t.RemainingWork > 0 Then
                                i = i + 1
                                ' write info to excel
                                swaWorksheet.Cells(i, 1) = t.Text28
                                swaWorksheet.Cells(i, 2) = t.OutlineParent.Name
                                swaWorksheet.Cells(i, 3) = t.UniqueID
                                swaWorksheet.Cells(i, 4) = t.Name
                                swaWorksheet.Cells(i, 5) = t.Start
                                swaWorksheet.Cells(i, 6) = t.Finish
                                swaWorksheet.Cells(i, 7) = t.Work / (60 * 8)
                                swaWorksheet.Cells(i, 8) = t.ActualWork / (60 * 8)
                                swaWorksheet.Cells(i, 9) = t.RemainingWork / (60 * 8)
                                ' Debug.Print t.Text28; " "; t.OutlineParent.Name; " "; realname; " "; t.Name, t.Start; t.Finish; t.Work / 60; t.ActualWork / 60; t.RemainingWork / 60
                                ' if Finish Date in the same calendar week then highlight the entire row
                                datTestDate = DateSerial(Year(t.Finish + (8 - Weekday(t.Finish)) Mod 7 - 3), 1, 1)
                                intCalendarWeekFinish = (t.Finish - datTestDate - 3 + (Weekday(datTestDate) + 1) Mod 7) \ 7 + 1
                                If intCalendarWeekFinish = intCalendarWeek Then
                                    ' Debug.Print realname, intCalendarWeek
                                    swaWorksheet.Rows(i).EntireRow.Interior.ColorIndex = 3 ' finish this week -> red
                                End If
                                If intCalendarWeekFinish = intCalendarWeek + 1 Then
                                    ' Debug.Print realname, intCalendarWeek
                                    swaWorksheet.Rows(i).EntireRow.Interior.ColorIndex = 6 ' finish next week -> yellow
                                End If
                            End If
                        Next t
                        ' pimp excel file, close excel file and clean up
                        swaWorkbook.Sheets(1).Columns("A:I").AutoFit
                        ' tricky
                        excelApp.Goto swaWorkbook.Sheets(1).Range("A2")
                        excelApp.ActiveWindow.FreezePanes = True
                        ' format columns and stuff
                        swaWorkbook.Sheets(1).Columns("A").ColumnWidth = 20
                        swaWorkbook.Sheets(1).Columns("B").ColumnWidth = 70
                        swaWorkbook.Sheets(1).Columns("C").ColumnWidth = 6
                        swaWorkbook.Sheets(1).Columns("D").ColumnWidth = 70
                        swaWorkbook.Sheets(1).Columns("G").NumberFormat = "0.0"
                        swaWorkbook.Sheets(1).Columns("H").NumberFormat = "0.0"
                        swaWorkbook.Sheets(1).Columns("I").NumberFormat = "0.0"
                        '
                        excelApp.ActiveWorkbook.Sheets(1).Activate ' ugly, but works
                        With excelApp.ActiveSheet
                            .AutoFilterMode = False
                            .Range("A1:I1").AutoFilter
                        End With

                        ' if on Excel >= 2010 then select all entries and autoformat table
'                        swaRange = "$A$1:$I$" + CStr(i)
'                        excelApp.ActiveSheet.ListObjects.Add(xlSrcRange, Range(swaRange), , xlYes).Name = "Tabelle3"
'                        excelApp.Range("Tabelle3[#All]").Select
'                        excelApp.ActiveSheet.ListObjects("Tabelle3").TableStyle = "TableStyleMedium2"

                        ' save and exit Excel
                        excelApp.ScreenUpdating = True
                        excelApp.Calculation = xlCalculationAutomatic
                        swaWorkbook.SaveAs swaFilename
                        swaWorkbook.Close (True)
                        excelApp.Quit
                    Else
                        MsgBox ("File " + swaFilename + " exists. Lets stop here.")
                        End
                    End If
                End If
            End If
        End If
    Next r

    Application.StatusBar = ""

End Sub

I’m a passionate golfer and one thing I’ve learned in +20 years of play is that – besides solid ball striking – it pays off to know the course in advance. Be prepared. Based on your skills and clubs you can develop a strategy for the course. For each hole, you estimate distances and check hazards and the way the green is defended with bunkers. Eventually, you document your findings in a yardage map for later use.

What does all this have to do with project management, you ask? Well, this post is a first in a series of blog posts where I document my yardage map for projects – everything I need to successfully tackle projects in the IT industry.

My background

I’m currently employed both as a line manager and as a project manager for 7-figure contracts – teams of up to 30 employees. In the past, I’ve documented my tips and tricks in a number of places – files on my hard-drive, e-mails, and so forth. Over the years, this got too messy and I figured out this had to change. So why not publish my knowledge in a series of blog posts? My key idea is to list must-have or must-do items for each phase of a project for later reference.

The content

This blog is intended for project managers who look for practical tips and best practices. You will learn how to sharpen the scope of a project, create a proper project plan and even more importantly, how to automagically update the plan with minimal effort. An updated project plan is a key instrument for making sound decisions. For tracking projects, I use MS Excel and MS Project and you’ll learn a number of macros. For the impatient, check out the macro collection for MS Project or for Excel.

The upcoming posts are structured along PMI’s process groups which roughly correspond to the phases of a project.

Initiating
- Shall I take over the job as project manager or not?
- Use a project definition report to avoid failure.
Planning
- The basics – what do I need?
- How do I create a project plan?
- Check your plan with this best practices checklist.
Executing, Monitoring and Controlling
- The basics – what do I need?
- The weekly cycle – how do I update the plan each week?
Closing
- Say “Thank you”

This post serves as a table-of-contents for future posts. Stay tuned for more to come.

waldherr.org

Category Archives: Project Management

Predecessors in MS Project

Export timesheets from MS Project to MS Excel

Yardage Map for Projects

My background

The content