1

I have been given a spreadsheet that lists a number of resources and the resource rates for each financial year for the next ten years. Each year starts on May 1st.

Every month there is the potential for these rates to change, maybe someone gets promoted for example, and their rates change.

I am trying to figure out a way that I can import the resource rates into the Resource Sheet in Microsoft Project from an Excel spreadsheet and have the resource rate Table A updated to reflect the new rates for each FY period (e.g. for the next ten years).

I know I need a macro to do this but I am unsure where to start. An import map doesn't seem to work.

My starting point was to use this code

Sub SetRateAfromEntField()

    'Declare Variables
    Dim Res As Resource

    'Loop All Resources
    For Each Res In ActiveProject.Resources
    
        'Check for Real Resource
        If Not (Res Is Nothing) Then
               
            'Set Rate Table A from Std. Rate A
            Res.CostRateTables(1).PayRates(Res.CostRateTables(1).PayRates.Count).StandardRate = Res.GetField(FieldNameToFieldConstant("Std. Rate A", pjResource))
            
        End If
           
    Next Res
    
End Sub

and assume the existence of a resource custom field that already contains the rate, and therefore I would need ten custom fields.

However, in my case the data resides in an Excel sheet. Each resource has a unique reference code (resCode) which exists in both the Excel sheet and in the resource pool for each resource.

I'm trying to figure out a way to directly read the rates in from the spreadsheet and have the resources rates updated on a periodical basis.

I saw this code which looks close but doesn't include the reference to the data being stored in an Excel spreadsheet from which the rates need to be read in. https://pm.stackexchange.com/questions/25019/ms-project-multi-year-inflation

In summary:

Resource Rates for each year for the next 10 years are stored in a spreadsheet.

Resources are uniquely mapped to a resource code (resCode) in both the Excel sheet and in project.

Rates need to be updated each month by running a macro to import the rates.

Any help on how best to achieve this would be gratefully received.

Witherfield
  • 135
  • 1
  • 1
  • 13
AHowes
  • 11
  • 1

1 Answers1

0

I believe you want to be able to import rates from a spreadsheet like this:

spreadsheet

In this example, the name of the resource is listed in column A, the rate effective date is listed in row 1, and the rate value is the intersection of the resource name and effective date.

I'm running off the assumption that resources with these exact same names exist in the resource sheet of the MS Project file I'm going to import the rates into.

Here is the code, written in Excel VBA:

Sub ImportRatesToAProject()

    'Using late binding on MS Project objects since code is being written in Excel VBA
    Dim res As Object 'Resource
    Dim prjApp As Object

    Set prjApp = GetObject(Class:="MSProject.Application") 'late binding
    
    'Turn MS Project calculations and screen updating off to make code run faster.
    prjApp.Calculation = 0 'pjManual
    prjApp.ScreenUpdating = False
    
    For r = 2 To ActiveSheet.UsedRange.Rows.Count
        For Each res In prjApp.ActiveProject.Resources
            'Check if the resource in the project resource sheet is the same as the one in our spreadsheet.
            If Trim(ws.Cells(r, 1)) = Trim(res.Name) Then 
                'Call method to delete current rates with the same effective dates as we are going to add
                DeleteExistingRates res
                'Call method to add new rates
                AddNewRates res
                'Color the cell so we know the import occured
                ws.Cells(r, 1).Interior.Color = vbYellow
            End If
        Next res
    Next r
    
    'Turn MS Project calculations and screen updating back on
    prjApp.Calculation = -1 'pjAutomatic
    prjApp.ScreenUpdating = True

End Sub

Private Sub DeleteExistingRates(res As Object)

    If Not res Is Nothing Then
        Dim rRate As Object
        Dim pRate As Object
        Dim c As Integer
        
        Set rRate = res.CostRateTables(1)
        
        'Loop through all the payrate objects and remove the rates with the same effective dates as our new rates
        For Each pRate In rRate.PayRates
            For c = 2 To ws.UsedRange.Columns.Count
                If IsDate(ws.Cells(1, c)) Then
                    'check if effective dates are the same date
                    If Format(pRate.EffectiveDate, "mm/dd/yyyy") = Format(ws.Cells(1, c), "mm/dd/yyyy") Then
                        pRate.Delete
                    End If
                End If
            Next c
        Next pRate
    End If

End Sub

Private Sub AddNewRates(res As Object)
    
    If Not res Is Nothing Then
        Dim rRate As Object
        Dim pRate As Object
        Dim c As Integer
        
        Set rRate = res.CostRateTables(1)
        
        'Add all the new rates we want from our spreadsheet using this loop
        For c = 2 To ws.UsedRange.Columns.Count
            Set pRate = rRate.PayRates.Add(CDate(ws.Cells(1, c)), CDbl(ws.Cells(r, c))) 'parameters are the effective date and the rate
            
            'color rate cell so we know the rate was imported
            ws.Cells(r, c).Interior.Color = vbYellow
        Next c
    End If

End Sub

Note that since I'm writing the code in Excel VBA, I'm using Late Binding (other helpful article) to access the MS Project objects.

Kenny Arnold
  • 406
  • 2
  • 8