Category Archives: Project tips

Predecessors in MS Project

Have you ever been annoyed, that MS Project does not list you dates of predecessors in its task form? How do you quickly determine the driving predecessor? If you have many predecessors for a tasks, finding the driving task (without switching views…) can become pretty cumbersome.
Microsoft Project - foo

The solution: add a button to MS Project and run a macro that lists all unfinished predecessors along with its line number and finish date.

Microsoft Project - MSgBOx

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

Public Sub swaPre()
    Dim t As Task
    Dim msg As String
    msg = ActiveSelection.Tasks.Item(1).Name & vbNewLine & vbNewLine
    For Each t In ActiveSelection.Tasks.Item(1).PredecessorTasks
        ' remove all closed predecessors
        If t.PercentComplete <> 100 Then msg = msg & t.ID & vbTab & Left(t.Name, 30) & vbTab & Format(t.Finish, "dd.mm.yyyy") & vbNewLine
    Next t
    MsgBox msg, vbInformation, "Predecessors, percent complete <> 100 and finish dates"
End Sub

Export timesheets from MS Project to MS Excel

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.

Microsoft Excel - Timesheet-2014-28-foo

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

Quality check project plan on the fly with custom fields

I want to ensure that all tasks in my project plan have certain custom fields sets (like team lead, contract id, deliverable, etc.). To spot the tasks that lack this information, I’ll highlight them in my Gantt view.

First step, add a custom field, say, number18 and a formula that checks certain fields and returns

  • -1 for milestones and summaries,
  • 0 for all quality checks ok, and
  • a number greater zero if the quality check fails.
IIf([Milestone]=True;-1;IIf([Summary]=True;-1;IIf([Text7]="";1;IIf([Text15]="";2;IIf([Text27]="";3;IIf([Text28]="";4;IIf([Text16]="";5;IIf(InStr([Resource Phonetics];[Text16])=0;6;IIf([Type]<>2;7;
IIf([Baseline Finish]=projdatevalue("NA");8;0))))))))))

Second step, add a flag, say flag20 to be true if the quality check fails (number19 is greater 0) or false otherwise.

IIf([Number18]>0;True;False)

Third step, format the gant chart based on flag20.

How to show trends in MS Project

In short, you can’t ;-). MS Project is good at showing all sorts of info on your project for any given point in time. It does not, however, contain historic data to calculate trends. But there is a workaround. In each reporting cycle (say every week), save your project plan to a new file. Then use Excel and a macro to read all past project plans and chart the trend. Use pivot tables to drill down to deliverable or sub-projects. Here is how to chart work compared to baseline work over time. Continue reading

How to import and export nonworking time in MS Project

Not reflecting holidays in project plans can have many nasty side-effects. Tasks end later than you think because people are not available. If you have longer projects, the number of holiday days, bridging days and other nonworking time add up and can significantly extend your project far beyond your established deadline.

Using “Tools | Change working time … ” in MS Project you can change both the project calendar and the calendar of each team member. However, this process is cumbersome. The following macros update nonworking time from an Excel file. Continue reading

Dump actual work from MS Project into Excel

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. Continue reading

Set the same text styles in all views for MS Project

Running the following macro from your gantt-like views will standardize the view to use identical text styles.

'
' works only for gantt like charts
'
Sub swaMSPSetTextStyles()
    If ActiveProject.Views.Item(ActiveProject.CurrentView).Type = 0 Then
        TextStyles Item:=pjAll, Size:="8", Bold:=False, Italic:=False, Color:=pjBlack
        TextStyles Item:=pjNoncritical, Size:="8", Bold:=False, Italic:=False, Color:=pjBlack
        TextStyles Item:=pjGanttExternalTask, Size:="8", Bold:=False, Italic:=False, Color:=pjGray
        TextStyles Item:=pjMarked, Size:="8", Bold:=False, Italic:=True, Color:=pjNavy
        TextStyles Item:=pjTaskRowColumnTitles, Size:="8", Bold:=True, Italic:=False, Color:=pjBlack
        TextStyles Item:=pjGanttMajorTimescale, Size:="8", Bold:=True, Italic:=False, Color:=pjBlack
    End If
End Sub

How to add VBA code to your computer

First of all, all VBA examples on this website use MS Excel 2003 2010 and/or MS Project 2003 2010. Most of the stuff may run with later versions, YMMV. Also, keep an eye on formulas in Excel: you may need to replace each colon with a comma (or tweak your regional settings in Windows).

Add code to MS Excel

  • I store all my macros in a central place (personal.xls), so that I can use them in all spreadsheets.
  • On my Win7 box, the file is located in %APPDATA%\Microsoft\Excel\XLSTART
  • Read, how to add macros to your personal.xls.
  • Hide personal.xls when you’re not working on your macros (via Window | Hide).

Add code to MS Project

  • I store all my macros in a central place (global.mpt), so that I can use them in all projects.
  • On my Win7 box, the file is located in %APPDATA%\Microsoft\MS Project\11\1033
  • You can move macros and other settings between different project files and global.mpt using MS Project’s organizer function, see Tools | Organizer.

Don’t forget to backup both files on a regular basis.