Office Tech Support - Project, Access, Excel

MS Project Change Calendar and Preserve Dates

Trevor Lowing, PMP — Mon, 17 Oct 2011 21:46:36 +0000

Many a Project Manager or Planner has encountered the following scenario: the project team has developed a outline schedule and is ready to snap a baseline when someone notices that the incorrect calendar was used. So how do you change the calendar and preserve the original dates? The following procedure is the only method I know of that will let you do this without a lot of rework.

1) Set a Baseline (use Baseline 1-10 if you only want a temp baseline. Tools->Tracking-> Save Baseline. Save Interim Plan->Copy “Start/Finish” Into “Baseline 1″)
2) Select all tasks (select row IDs at right, right click and select “Task Information”).
3) Go to Task Information->Advanced and change task type to “Fixed Units” and check “Effort Driven”
4) Change calendar
5) Select all tasks, go to task properties and change task type back to “Fixed Duration” and uncheck “Effort Driven if desired.

Using Named Ranges to Import SAP Excel Reports into Access

Trevor Lowing, PMP — Fri, 15 Jul 2011 12:43:05 +0000

SAP is the predominant ERP software for most large businesses. Unfortunately SAP reports are usually exported as Excel spreadsheets that seem poorly formatted for importing into a database using automation (VBA). The trick to import that data is to used Excel Named Ranges. Named ranges are a short textual name given to a cluster of cells in an Excel worksheet. Here are the steps to set up an automation routine for importing SAP spreadsheets.

1) Take an example SAP Excel workbook and use the Access importing wizard (External Data->Excel in Access 2007 or Access 2010). Browse to the document and Seelect the Import Option and select Next.

2) From the top of the dialog page that appears select “Show Named Ranges” and choose the range named “SAPBEXqueries!SAPBEXq0001″.

3) Allow the wizard to select the first row as column headers. Click next.

4) On the field options page I recommend selecting “Text” as Data Type for most fields if you are uncertain of their type. Click next and let access add a primary key if you would like. Click Next.

5) Change the name of the table you will be using for import to whatever you would like. It will probably default to “SAPBEXqueries”. Click finish.

6) Now you have a table with all the proper field definitions to accept automated imports for your automation routine. All that is left is to build a routine to import the data automatically.

Function ImportSAPData() Dim strFilePath As String strFilePath = "C:\Data\SAP\SAPReport.xls" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "SAPBEXqueries", strFilePath, True, "SAPBEXqueries$SAPBEXq0001" If Err.Number 0 Then MsgBox "Error Importing " & strFilePath & " " & Err.Description Err.Clear 'Clear the Error Object End If End Function

Referencing CurrentRecord in Access Form DataSheet View

Trevor Lowing, PMP — Thu, 14 Jul 2011 13:35:35 +0000

So you want to use a DataSheet form in MS Access to edit your data but you can’t think of how to reference the record the user has selected? The answer is easy, the record that has the focus can be referenced with the usual “Me.MyFieldName.Value” command you use on forms editing a single record. The frmMYForm.CuccentRecord command will return a Long value representing the current row-number – probably more useful for color-coding or highlighting the currently selected row.

Private Sub Field1_Change() MsgBox Me.Field1.Value End Sub

Quickly Creating or Updating a Custom MS Project Calendar

Trevor Lowing, PMP — Sat, 31 Jul 2010 21:37:47 +0000

The process of defining a calendar with holidays is a cumbersome and error-prone task in MS Project. Some of the projects I work on can span a decade and go through several calendar revisions so manually creating or revising the calendar is impractical. So Heres a quick way to add and update a custom calendar.

Create a new project.
Follow this process define the base calendar working days or use a “Standard” calendar.
Create a Excel workbook and fill the first worksheet with two columns to represent non-working time periods. The first column will have period start and the second period end.
Modify the BaseCalName with the base calendar to use, CalName with the name of the new calendar you are creating and ExcelPath with the path to the spreadsheet you created in the previous step.
Paste this function into ThisProject in MS Project by going to Tools–>Macro–>Visual Basic Editor.
Run Macro. This macro will delete any calendar with the same name when it runs before creating the new one.

Function CreateProjectCalendar() Dim oConn As New ADODB.Connection Dim oRS As New ADODB.RecordSet Dim i As Integer Dim CalName, BaseCalName, ExcelPath, strRequest As String BaseCalName = "Standard" CalName = "MyCalendar" ExcelPath = "C:\Book1.xls"


    Dim oCal As Calendar
    'make sure calendar does not already exsits and delete if it does.

    For Each oCal In ActiveProject.BaseCalendars

        If Not oCal Is Nothing Then

            If oCal.Name = CalName Then

                oCal.Delete

            End If
        End If
    Next
    With oConn

        .Provider = "Microsoft.Jet.OLEDB.4.0"

        .Properties("Extended Properties").Value = "Excel 8.0"

        .Open "C:\Book1.xls"

    End With
    strRequest = "SELECT * FROM [Sheet1$]"

    oRS.Open strRequest, oConn

    Application.BaseCalendarCreate Name:=CalName, FromName:=BaseCalName
    Do While Not oRS.EOF
        For i = 0 To oRS.Fields.Count - 1

            If IsDate(oRS.Fields.Item(0).Value) And IsDate(oRS.Fields.Item(1).Value) Then

                Application.BaseCalendarEditDays Name:=CalName, StartDate:=oRS.Fields.Item(0).Value, EndDate:=oRS.Fields.Item(1).Value, Working:=False, Default:=False

            Else

                MsgBox "Error, Bad Date Value: Start=" & oRS.Fields.Item(0).Value & " Finish= " & oRS.Fields.Item(1).Value

            End If

        Next

        oRS.MoveNext

    Loop

    oRS.Close

    oConn.Close

    Set oRS = Nothing

    Set oConn = Nothing

End Function

Cheers,

Trevor Lowing, PMP
Office Tech Support

MS Project Date Math

Trevor Lowing, PMP — Wed, 28 Jul 2010 13:30:33 +0000

Microsoft Project adds a little twist to standard date math. Because tasks and resources can be assigned calendars, special functions must be used to properly perform math operations to account for working days and working hours. Below are some sample functions.

Cheers,

Trevor Lowing, PMP
Office Tech Support

Date Math

Regular VB
Project VBA
Project Field Formula

Add Dates

DateAdd(Interval, Number, Date) Read More…
Application.DateAdd(date,duration,calendar)*
ProjDateAdd(date,duration,calendar)*

Subtract Dates

DateAdd(Interval, -Number, Date) Read More…
Application.DateSubtract(date,duration,calendar)*
ProjDateSub(date,duration,calendar)*

Date Difference

DateDiff(interval, date1, date2, firstdayofweek, firstweekofyear) Read More…
Application.DateDifference(date1,date2,calendar)*
ProjDateDiff(date1,date2,calendar)*

* Calendar can be expressed as a constant such as ActiveProject.Calendar or a strign name such as “Standard”. Duration is in minute units and can be converted to days by the formula “(60 * ActiveProject.HoursPerDay)”. Please see the online help for more information.

Function FirstWorkingDayOfMonth(ByVal dtmInput As Date) As Date


    Dim dtmLast As Date

    Dim intOneDay As Integer

    intOneDay = (60 * ActiveProject.HoursPerDay)
    'Get Last day of previous month

    dtmLast = DateAdd("d", (Day(dtmInput) - 1) * -1, dtmInput)

    'add one working day

    FirstWorkingDayOfMonth = Application.DateAdd(dtmLast, intOneDay, ActiveProject.Calendar)
End Function
Function LastWorkingDayOfMonth(ByVal dtmInput As Date) As Date
    Dim dtmFirst As Date

    Dim intOneDay As Integer

    intOneDay = (60 * ActiveProject.HoursPerDay)

    'Add one month

    dtmFirst = DateAdd("M", 1, dtmInput)

    'Get first working day of month

    dtmFirst = FirstWorkingDayOfMonth(dtmFirst)
    'subtract one working day

    LastWorkingDayOfMonth = Application.DateSubtract(dtmFirst, intOneDay * 2, ActiveProject.Calendar)
End Function
Function WorkingDaysInMonth(dtmInput As Date) As Integer
    Dim dtmFirst1, dtmFirst2 As Date

    Dim intDays As Integer

    'Get First Day of Month

    dtmFirst1 = DateAdd("d", (Day(dtmInput) - 1) * -1, dtmInput)

    'Get First Day of Next Month

    dtmFirst2 = DateAdd("m", 1, dtmFirst1)
    intDays = Application.DateDifference(dtmFirst1, dtmFirst2, ActiveProject.Calendar) / 60 / ActiveProject.HoursPerDay
    WorkingDaysInMonth = intDays

End Function

Assigning Outlook Contacts a Numerical Customer Id

Trevor Lowing, PMP — Mon, 19 Jul 2010 16:57:55 +0000

Contacts have a built-in field called CustomerId. After you run this you can add the CustomerId column to the Contact Folder view. Call this on a New Item event for the contact folder to make it automatic.

cheers,

Trevor Lowing
Office Tech Support


Sub SetCustomerIDs()

    Dim ol As Outlook.Application

    Dim olns As Outlook.NameSpace

    Dim oConItems As Outlook.Items

    Dim oCurItem As Object

    Dim I, J, iNumItems, iContactId As Integer

    Set ol = New Outlook.Application

    Set olns = ol.GetNamespace("MAPI")

    Set oConItems = olns.GetDefaultFolder(olFolderContacts).Items

    iNumItems = oConItems.Count

    iContactId = 0
    For I = 1 To iNumItems

        Set oCurItem = oConItems.Item(I)

        If TypeName(oCurItem) = "ContactItem" Then

            J = oCurItem.CustomerID

            If IsNumeric(J) Then

                If J > iContactId Then

                    iContactId = J

                End If

            End If

        End If

    Next
    iContactId = iContactId + 1

For I = 1 To iNumItems Set oCurItem = oConItems.Item(I) If TypeName(oCurItem) = "ContactItem" Then If oCurItem.CustomerID = "" Then oCurItem.CustomerID = iContactId iContactId = iContactId + 1 oCurItem.Close olSave End If End If Next Set oConItems = Nothing Set olns = Nothing Set ol = Nothing End Sub

Tracking MS Project Schedule Baseline Slips in Realtime

Trevor Lowing, PMP — Sun, 18 Jul 2010 06:15:54 +0000

Once you have baselined your schedule it becomes very important to monitor schedule changes that cause the forceast to differ from the baseline. The instructions below allow the user to visually track any change from the forecast while you are working on the schedule.

This macro works by adding a custom formula to two user defined MS Project fields. Additionally, a filter can be added to only view activities flagged at a given Level od the Project WBS. Use the field Number1 to denote the level in the IMS (1-5) and you would have to do the same for the filter to work. Here’s how to make the Level 3 slip checker:

Start Delta

Rename field Number5 to “Start Delta”

Add the following formula:

IIf([Baseline Start]projdatevalue("NA"),Fix([Start]-[Baseline Start]),0)

Finish Delta

Rename field Number6 to “Finish Delta)

Add the following formula:

IIf([Baseline Finish]projdatevalue("NA"),Fix([Finish]-[Baseline Finish]),0)

Create the following filter to view only slipped Level 3 tasks:

If you want to see the complete stuff too then leave that part off.

Cheers,

Trevor Lowing
Office Tech Support

MS Project Show Only Summary Bars

Trevor Lowing, PMP — Thu, 15 Jul 2010 06:29:08 +0000

One question I’m frequently asked is how to display only summary bars in the MS Project GanTT view. If you collapse all the summary bars manually then you can’t see summary bars beneath other summary bars. So to see ALL of the summary bars I created the following little macro.

Sub Show_Summary_Bars() 'set the flag field for the selected tasks Dim oTasks As Tasks Dim oTask As Task Set oTasks = ActiveProject.Tasks For Each oTask In oTasks


        If Not oTask Is Nothing Then
            oTask.Flag1 = "No"
            If oTask.Rollup = True Or oTask.Summary = True Then

                oTask.Flag1 = "Yes"

            End If
        End If

    Next oTask
    'filter to show just the selected tasks

    FilterEdit Name:="SummaryBars", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag1", Test:="equals", Value:="Yes", ShowInMenu:=False, ShowSummaryTasks:=False

    FilterApply Name:="SummaryBars"

End Sub
Cheers,

Trevor Lowing
Office Tech Support

MS Project Automated Date Preservation/Archiving

Trevor Lowing, PMP — Sun, 11 Jul 2010 06:05:14 +0000

Once a Project base been baselined we have to be concerned with change management. Your business process may address the preservation of baseline dates, but how to you preserve schedule forcast dates at various times in the project execution? Below is one possability. Utilize the extra baseline fields to preserve forecast dates (start/finish, duration, etc) on a routine basis so analysis and ad-hoc reporting can be done. The macro below accomplishes automated forcast preservation. Actuate this macro manually, via a button or attahc it to the OnSave event.

This macro works like this:

If a new quarter starts, prompts the user to save the dates to the appropriate baseline. IF a new month stats, prompts the user to save to Basekine 5. If a new two week period starts, prompts the user to save to Baseline6. If the user isn’t ready to save the baseline for that quarter or month then will they be able to make changes, save the file, re-open and then save to the appropriate baseline?

‘Baseline 1 = Q1
‘Baseline 2 = Q2
‘Baseline 3 = Q3
‘Baseline 4 = Q4
‘Baseline 5 = last 2 weeks
‘Baseline 6 = last month

Add this code to a project using Tools->Macro->Visual Basic Editor

Paste into ThisProject

Cheers,

Trevor Lowing
Office Tech Support

‘========== START CODE =======================


Option Explicit
Function Archive()

    On Error GoTo UnexpectedError

    Dim archiveInfo As String

    'Data storage format

    'used the project's status field to store last archived dates then uses these baselines

    'Baseline 1 = Q1

    'Baseline 2 = Q2

    'Baseline 3 = Q3

    'Baseline 4 = Q4

    'Baseline 5 = last 2 weeks

    'Baseline 6 = last month

    '
    'ActiveProject.Subject = "Last Archived Dates (Qtr : Month : BiWeekly) :12/12/2010:12/12/2010:12/12/2010"

    archiveInfo = ActiveProject.Subject
    Dim arrDates

    Dim currentDate, dtmQ, dtmM, dtmB As Date
    currentDate = ActiveProject.StatusDate

    'make sure th status date is set, if not then default to today

    If Not IsDate(ActiveProject.StatusDate) Then

        currentDate = Date

    Else

        currentDate = ActiveProject.StatusDate

    End If
    arrDates = Split(archiveInfo, ":")
    '

    If UBound(arrDates) > 0 Then

        If IsDate(arrDates(3)) Then

            dtmQ = DateValue(arrDates(3))

        End If

        If IsDate(arrDates(4)) Then

            dtmM = DateValue(arrDates(4))

        End If

        If IsDate(arrDates(5)) Then

            dtmB = DateValue(arrDates(5))

        End If

    End If
    ' identify the current status fiscal quarter, then identify if we need to archive
    Dim a As Integer
    'If the quarter has changed or it's been longer than 100 days

    If (FiscalQuarter(dtmQ)  FiscalQuarter(currentDate)) Or (DateDiff("d", dtmQ, currentDate) > 100) Then

        'see if we want to archive

        a = MsgBox("A new fiscal quarter has begun(qtr " & FiscalQuarter(currentDate) & "), commence archive to Baseline" & FiscalQuarter(currentDate) & "?", vbYesNo)

        If a = vbYes Then

            Select Case FiscalQuarter(currentDate)

            Case 1

                BaselineSave All:=True, Copy:=0, Into:=11

            Case 2

                BaselineSave All:=True, Copy:=0, Into:=12

            Case 3

                BaselineSave All:=True, Copy:=0, Into:=13

            Case 4

                BaselineSave All:=True, Copy:=0, Into:=14

            Case Else

            End Select
            dtmQ = currentDate

        End If

    End If

    'if the month has changed or it's been more than 63 days

    If (Month(dtmM)  Month(currentDate)) Or (DateDiff("d", dtmQ, currentDate) > 63) Then

        'see if we want to archive

        a = MsgBox("A new month has begun, commence archive to Baseline5?", vbYesNo)

        If a = vbYes Then

            BaselineSave All:=True, Copy:=0, Into:=15

            dtmM = currentDate

        End If

    End If
    'if it's been more than 14 days

    If DateDiff("d", dtmB, currentDate) > 14 Then

        'see if we want to archive

        a = MsgBox("A new two-week period has begun, commence archive to Baseline6?", vbYesNo)

        If a = vbYes Then

            MsgBox "hello"

            BaselineSave All:=True, Copy:=0, Into:=16

            dtmB = currentDate

        End If

    End If
    'archive schedule preservation dates in the project's "status" field

    ActiveProject.Subject = "Last Archived Dates (Qtr : Month : BiWeekly) :" & dtmQ & ":" & dtmM & ":" & dtmB
    Exit Function

UnexpectedError:

    ' Describe the error to the user.

    MsgBox "Send this message to Trevor Lowing: Unexpected error" & _

           Str$(Err.Number) & _

         " in subroutine DoSomething." & _

           vbCrLf & _

           Err.Description

    Exit Function

End Function
Function FiscalQuarter(dtmIn) As Integer
    Select Case Month(dtmIn)

    Case 10, 11, 12

        FiscalQuarter = 1

    Case 1, 2, 3

        FiscalQuarter = 2

    Case 4, 5, 6

        FiscalQuarter = 3

    Case 7, 8, 9

        FiscalQuarter = 4

    Case Else

        FiscalQuarter = 0

    End Select

End Function
Private Sub Project_BeforeSave(ByVal pj As MSProject.Project)

    Call Archive

End Sub

‘==========FINISH CODE =======================

Calculate Next Friday or Next Saturday in VB

Trevor Lowing, PMP — Fri, 18 Jun 2010 06:47:47 +0000

For standard reporting I’m often confronted with querying for data up to a future or past date that falls on Friday or Saturday so I created the following functions. DayCount is the number of days in the past or future to project the date from. Use a negative value to get those dates in the past.

Function FutureSaturday(ByVal DayCount As Integer) As Date Dim newdate As Date newdate = Date + DayCount FutureSaturday = newdate + (7 - DatePart("w", newdate)) End Function

Function FutureFriday(ByVal DayCount As Integer) As Date Dim newdate As Date newdate = Date + DayCount FutureFriday = newdate + (6 - DatePart("w", newdate)) End Function

Cheers,

Trevor Lowing
Office Tech Support