none
VBA Macro Help - Cost Rate Tables RRS feed

  • Question

  • Hello everyone. I am in need of some help. I am not a VBA user, but I am hacking my way through it. The code below has taken me two days to figure out and make it work, so that's what you are dealing with. I am using MSProj 2010 PRO, standalone and I have some code here that is designed to change a resources rate table for a specific client. This code works, but only by the resource name so I need some additional help please. Here is the code that works based on name;

    ' Macro NOVA_Rates adds new rate information to the Cost Rate Table for a given "name" of resource
    Sub NOVA_Rates()
    Dim NOVA As CostRateTable
    '' The following line sets the resource
    Set NOVA = ActiveProject.Resources("Gina").CostRateTables("B")
        ''The following line sets the Cost Rate Table A,B,C,D, or E with a payrate effective date DD/MM/YYYY, StdCost, OTCost, Per Use Cost
    ActiveProject.Resources("Gina").CostRateTables("B").PayRates.Add "7/2/2011", "$276/h", "$1000/h", "$0"

    End Sub

     

    Here is what I need help with. I have "Text1" column (renamed 'Resource Level') with some resource type information, such as "Project Manager", "Engineer", etc. I would like to have this code read the column "Text1" and based on the text, it would determine which set of rates need to go into the Cost Rate Table "B".

    For example:

    1 - if "Text1" = "Project Manager", then it would use  ("Project Manager").CostRateTables("B").PayRates.Add "7/2/2011", "$1/h", "$5/h", "$0"

    2 - if "Text1" = "Electrical Engineer", then it would use  ("Electrical").CostRateTables("B").PayRates.Add "7/2/2011", "$2/h", "$6/h", "$0"

    3 - if "Text1" = "Mechanical Engineer", then it would use  ("Mechanical").CostRateTables("B").PayRates.Add "7/2/2011", "$3/h", "$7/h", "$0"

    If you could anotate it similar to the way I have, that would be great!

    Thanks

    Mike

     

     

    • Moved by Mike GlenModerator Thursday, September 20, 2012 3:05 PM More appropriate forum (From:Project Standard and Professional General Questions and Answers)
    Sunday, February 6, 2011 10:01 PM

Answers

  • Mike,

    When writing software code you have to keep in mind that software, (at least the kind that is most common), is very literal. It doesn't work with "intent", it works with exact syntax. Once you start thinking that way, writing code gets a whole lot easier.

    What I meant by the additional code is for the case when you need to change an existing cost rate table. Adding rates is no problem, you now know how to do that. But it you need to change an existing rate, then basically what you need to do is to delete the rate that is already there and then add in the new data. You can't just "overwrite" what is already there. That's part of the reason my first post includes a "clearing loop". The "additional code" then becomes a variation on the clearing loop (i.e. delete back to the point where you need to re-enter the data.)

    Are you telling me that you need more than 125 different rates for a given resource? There are 5 rate tables and each can have up to 25 separate rate schedules. That's a lot of flexibility I think.

    You're welcome and thanks for the feedback.

    John

    Tuesday, February 8, 2011 3:34 AM

All replies

  • Mike,

    First I assume you mean the data is in Resource Text1 and not in the Task Text1 field. Based on that assumption, this code should do it. Note that it only looks at the first few characters of the text string in Text1. It is always a little dicey to test for exact text strings. For example, lets say someone entered "Electrical engneer". The intent is pretty clear but if the code looked for the full "electrical engineer", it would not add the data due to the inadvertent data entry.

    Option Compare Text

    Sub NOVA_Rates()

    Dim r As Resource

    For Each r In ActiveProject.Resources

        'jump around blank lines on Resource Sheet

        If Not r Is Nothing Then

            'only do this if resource is labor type

            If r.Type = pjResourceTypeWork Then

                'first clear all pay rate data

                'Note: this is necessary if the macro is run a 2nd time with

                'the same data. Additional code is necessary to add new data

                'to existing pay rate tables and clearing may not be necessary.

                For i = 1 To 5

                    'cycle through each of the 5 rate tables

                    Set pr = r.CostRateTables(i).PayRates

                    pr(1).StandardRate = 0

                    pr(1).OvertimeRate = 0

                    pr(1).CostPerUse = 0

                    'clearing must be done in reverse order

                    If pr.Count > 1 Then

                        For j = pr.Count To 2 Step -1

                            pr(j).Delete

                        Next j

                    End If

                Next i

                'set new object for "B" table only

                Set pr = r.CostRateTables("B").PayRates

                'add new rate data based on Resource Text1 field

                If InStr(1, r.Text1, "Proj") > 0 Then

                    pr.Add "7/2/2011", "$1/h", "$5/h", "$0"

                ElseIf InStr(1, r.Text1, "elec") > 0 Then

                    pr.Add "7/2/2011", "$2/h", "$6/h", "$0"

                ElseIf InStr(1, r.Text1, "mech") > 0 Then

                    pr.Add "7/2/2011", "$3/h", "$7/h", "$0"

                End If

            End If

        End If

    Next r  

    End Sub

    By the way, why the heck does a mechanical engineer get more than an electrical engineer? And oh yeah, the manger might want to weigh in on the rates also.

    John

    Sunday, February 6, 2011 11:35 PM
  • Tthanks John.

    While I was waiting for some help, I came up with this script. It seemed to work as soe of the subsequent information has been entered in my resource areas, but it didn't seem to like the second ElseIf after a second or two. I could send you the entire script, but it is repeatative. I set your first section of the clearing macro as a seperate macro. Can you help with this please?

    Sub Rates_2011()
    ' Macro Rates_2011 adds new rate information to the Cost Rate Table for a given "Type" of resource
    ' Macro Recorded Sat 05 Feb '11

    Dim Res As Resource
    For Each Res In ActiveProject.Resources
        'jump around blank lines on Resource Sheet
        If Not Res Is Nothing Then
            'only do this if resource is labor type
            If Res.Text1 = "Senior Process Engineer " Then
                Res.CostRateTables("A").PayRates.Add "01/01/2009", "$161/h", "$0/h", "0"
                Res.CostRateTables("A").PayRates.Add "07/02/2011", "4.5%", "$0/h", "0"
                Res.CostRateTables("B").PayRates.Add "01/02/2010", "$148.20/h", "$0/h", "0"
                Res.CostRateTables("B").PayRates.Add "21/02/2011", "$156/h", "$0/h", "0"
                Res.CostRateTables("C").PayRates.Add "07/02/2011", "$158.40/h", "$0/h", "0"
            ElseIf Res.Text1 = "Senior Project Manager or Specialist" Then
                Res.CostRateTables("A").PayRates.Add "01/01/2009", "$150/h", "$0/h", "0"
                Res.CostRateTables("A").PayRates.Add "07/02/2011", "4.5%", "$0/h", "0"
                Res.CostRateTables("B").PayRates.Add "01/02/2010", "$138.00/h", "$0/h", "0"
                Res.CostRateTables("B").PayRates.Add "21/02/2011", "$144.30/h", "$0/h", "0"
                Res.CostRateTables("C").PayRates.Add "07/02/2011", "$146.50/h", "$0/h", "0"
            ElseIf Res.Text1 = "Project Manager or Specialist" Then
                Res.CostRateTables("A").PayRates.Add "01/01/2009", "$139/h", "$0/h", "0"
                Res.CostRateTables("A").PayRates.Add "07/02/2011", "4.5%", "$0/h", "0"
                Res.CostRateTables("B").PayRates.Add "01/02/2010", "$127.90/h", "$0/h", "0"
                Res.CostRateTables("B").PayRates.Add "21/02/2011", "$135.30/h", "$0/h", "0"
                Res.CostRateTables("C").PayRates.Add "07/02/2011", "$137.40/h", "$0/h", "0"

           End If
        End If
    Next Res

    End Sub

     

    Any information would be very helpful...

    Mike

     

    Monday, February 7, 2011 8:00 PM
  • Mike,

    I guess you didn't like my suggestion about trying to match a whole text string. Okay. Just to drive the point home a little more directly, the first IF statement in your code includes a space after "engineer". Unintentional I'm sure, but with that little glitch, none of the senior process engineers on the Resource Sheet will get any rates updated if they don't also have that space. Comparing text strings to the nth degree can be a very dicey proposition. Enough said.

    I notice the first entry is for a senior process engineer but the second and third resource types depict multiple types (i.e. senior project manager OR specialist). Is that one resource or two? If the intent is an either/or resource type then the syntax is wrong. The correct syntax should be "Senior Project Manager" OR "Specialist" or perhaps, "Senior Project Manager" OR "Senior Project Specialist".

    I also note that you left out the IF statement that tests for a labor type resource. Indeed if the resource is a material or cost type, your code will fail when it hits that particular resource name.

    John

    Monday, February 7, 2011 8:59 PM
  • Hey John,

    Loved the code, but I seemed to have missed the nuances of VBA. I do appreciate the clarity on the space issue and tedium of VBA. Darn computers,so literal...

    I have adjusted the code and things seem to be working with your suggestions. Go figure, follow the expert advice and things work. ;-). I have decided to break up m CRT's into five different macros. It seems easier that way and if I screw up, it is only one table. . Here my new code:

    Sub CRT_A_2011()
    Dim r As Resource
    For Each r In ActiveProject.Resources
        'jump around blank lines on Resource Sheet
        If Not r Is Nothing Then
            'only do this if resource is labor type
            If r.Type = pjResourceTypeWork Then
                'set new object for "A table only
                Set pr = r.CostRateTables("A").PayRates
                'add new rate data based on Resource Text6 field
            If InStr(1, r.Text6, "SPE") > 0 Then
                pr.Add "01/01/2009", "$161/h", "0", "0"
                pr.Add "07/02/2011", "4.5%", "0", "0"
            ElseIf InStr(1, r.Text6, "PMS") > 0 Then
                pr.Add "01/01/2009", "$139/h", "0", "0"
                pr.Add "07/02/2011", "4.5%", "0", "0"
            ElseIf InStr(1, r.Text6, "SE2") > 0 Then
                pr.Add "01/01/2009", "$131/h", "0", "0"
                pr.Add "07/02/2011", "4.5%", "0", "0"
            ElseIf InStr(1, r.Text6, "SE1") > 0 Then
                pr.Add "01/01/2009", "$122/h", "0", "0"
                pr.Add "07/02/2011", "4.5%", "0", "0"

    and on and on and on....

    In your first set of code, you mentioned in the annotation that I would need additional code to add rates to existing tables. Can you tell me what that code is?

    Thank you for this information! You have probably solved a few hundred forum questions with this information. I am going to write something up on it and post it as a solution, giving you full credit of course. Now if only you could magically add more tabs to the Cost Rate Tables.

    Thank you for your rapid responses! It's nice to kow there are some great people out there!

    Mike

     

     

     

    Monday, February 7, 2011 9:23 PM
  • Mike,

    When writing software code you have to keep in mind that software, (at least the kind that is most common), is very literal. It doesn't work with "intent", it works with exact syntax. Once you start thinking that way, writing code gets a whole lot easier.

    What I meant by the additional code is for the case when you need to change an existing cost rate table. Adding rates is no problem, you now know how to do that. But it you need to change an existing rate, then basically what you need to do is to delete the rate that is already there and then add in the new data. You can't just "overwrite" what is already there. That's part of the reason my first post includes a "clearing loop". The "additional code" then becomes a variation on the clearing loop (i.e. delete back to the point where you need to re-enter the data.)

    Are you telling me that you need more than 125 different rates for a given resource? There are 5 rate tables and each can have up to 25 separate rate schedules. That's a lot of flexibility I think.

    You're welcome and thanks for the feedback.

    John

    Tuesday, February 8, 2011 3:34 AM
  • Good morning John,

    Thank's again. in the industry that I am in we have projects that go on for a long time, years. With the changes in rates we can have as many as five rate increases over that period. We have about sixty clients and they all have "special pricing". Recently the PM's have convinced my sales department to use a standard set of rates with an across the board savings or decrease/increase, but I got here they used individual rate percentage increases for each skill type for a given client. Imagine 20 different rates for 60 clients at 100 employees! CRAZY!

    What a CRT that has more than 5 tabs would do is allow users to have thier clients on a set rate and when the increase comes into play, VOILA! easy to set that up.

    As for me, I have won the battle over one set rate and by next year we should be good to go and change things up so that five tabs in the CRT would be sufficient.

    Thansks again!

     

     

    Tuesday, February 8, 2011 2:23 PM
  • Mike,

    Several years ago I wrote a rate increase macro for a client who needed to have an annual rate increase over a period of years, say 3% each year. However, those rate increases were reviewed annually and so the client also needed the ability to revise the rate schedule from that point forward. Similar to what you probably need. I developed a macro with a userform that allowed the client to enter a rate table, a date range for the increase, a rate escalation percentage, and a starting per hour rate for each of their 6 labor categories. I don't know if they still use it but it did exactly what they needed.

    Good luck with your VBA endeavors. You might be interested in MVP Rod Gill's book on Project VBA. It was originally written for Project 2007 but the last I spoke to Rod, he is apparently updating it for Project 2010. You should be able to get more info at, http://www.projectvbabook.com

    John

    Tuesday, February 8, 2011 4:26 PM
  • Hi Mike,
     
    Next time, try posting on the Project Customization and Programming forum:
    http://social.microsoft.com/Forums/en-US/project2010custprog/threads
     
    Please see FAQ Item: 52 Find a Forum.   FAQs, companion products and other useful Project information can be seen at this web address:  http://project.mvps.org/faqs.htm
     
    Mike Glen
    Project MVP
    Tuesday, February 8, 2011 4:45 PM
    Moderator
  • This is exactly what we need, except for the starting rate.  I enter a starting rate based on the cost center's rate, but do need to add the annual rate increase for the next 5 years.  At the beginning of each year then I will go into each cost center and update with the exact rate.  Just do not have the macro to do this.
    Wednesday, September 19, 2012 6:40 PM
  • digs65,

    Lot of water under the bridge since I responded on this one. Why not start a new thread and explain a bit more exactly what you need. It will make it a lot easier for me, or someone else, to help you.

    Also, what version of Project are you using? Is it updated with the latest service pack?

    John

    Wednesday, September 19, 2012 9:42 PM
  • Not exactly what you are saying but here is some code I wrote to to bulk updating based on a resource field so you can update differently based on certain sets of resources. It might get you closer.

    Sub CostRateChanger()
    'Brian Kennemer from Deltabahn, 2012
    'version 3
    'www.deltabahn.com
    
    'Use at own risk. No warranties or promises are made about how this code will work.
    
    'Test this code on a non-production system first!!!
    
        Dim R As Resource
        Dim crt As CostRateTable
        Dim prt As PayRate
        Dim prtFound As Boolean
        Dim Foundprt As Integer
        Dim OverwriteRate As Boolean
        Dim TableNum As Integer
        Dim tableLetter As String
        Dim EffDate As Date
        Dim StRate As String
        Dim perUse As String
        Dim OverTime As String
        Dim AccrueText As String
        Dim AccrueInt As Integer
        
    
        'Loop through all the resources in the activeproject
        
        For Each R In ActiveProject.Resources
            If Not (R Is Nothing) Then
                Select Case R.GetField(Application.FieldNameToFieldConstant("ENTERPRISE RESOURCE FIELD NAME", pjResource))
                
                    Case "VALUE ONE"
                        EffDate = "10/1/2012"
                        StRate = "1000/h"
                        OverTime = "1000/h"
                        perUse = "0"
                        AccrueText = "Start"
                        OverwriteRate = True
                        tableLetter = "A"
                    
                    Case "VALUE TWO"
                        EffDate = "10/1/2012"
                        StRate = "300/h"
                        OverTime = "300/h"
                        perUse = "0"
                        AccrueText = "Start"
                        OverwriteRate = True
                        tableLetter = "A"
                    
                    Case "VALUE THREE"
                        EffDate = "10/1/2012"
                        StRate = "300/h"
                        OverTime = "300/h"
                        perUse = "0"
                        AccrueText = "Start"
                        OverwriteRate = True
                        tableLetter = "A"
                End Select
                
                'Convert TableLetter to TableNum
                Select Case tableLetter
                Case "A"
                    TableNum = 1
                Case "B"
                    TableNum = 2
                Case "C"
                    TableNum = 3
                Case "D"
                    TableNum = 4
                Case "E"
                    TableNum = 4
                End Select
                '------------------------------------------------
    
                'Convert AccrueText to AccrueInt
                Select Case AccrueText
                Case "Start"
                    AccrueInt = 1
                Case "End"
                    AccrueInt = 2
                Case "Prorated"
                    AccrueInt = 3
                End Select
                '------------------------------------------------
                            
                'Set the Accrue At value for each resource
                R.AccrueAt = AccrueInt
                Debug.Print "-----"
                Debug.Print "ResourceName: " & R.Name
                Debug.Print "Notice: " & R.Name & " had their Accrue At value set to " & AccrueText
                
                '-----------------------------------
                'Check to see if there is already 25 entries in the specified
                'rate table
                'if there is then write a 'log' entry in the Immediate window '
                'and skip down to Next R
                
                If R.CostRateTables(TableNum).PayRates.Count = 25 Then
                    Debug.Print "Error: " & R.Name & _
                    " Already has 25 entries in CostRateTable " & tableLetter
                    GoTo SkiptoNext
                    
                End If
                '-----------------------------------
    
                '-----------------------------------
                'Look for an existing rate with the same effective date
                'if found then set a found flag and capture the index value
                For Each prt In R.CostRateTables(TableNum).PayRates
                    If prt.EffectiveDate = EffDate Then
                        prtFound = True
                        Foundprt = prt.Index
                    End If
                Next prt
                '-----------------------------------
                
                '-----------------------------------
                'if we find an existing effdate AND OverwriteRate is True then overwrite the existing rate with the new info
                'if Overwrite is False then dont do anything except write a log entry about skipping this resource
                If prtFound = True Then
                    If OverwriteRate = True Then
                        R.CostRateTables(TableNum).PayRates(Foundprt).StandardRate = StRate
                        R.CostRateTables(TableNum).PayRates(Foundprt).OvertimeRate = OverTime
                        R.CostRateTables(TableNum).PayRates(Foundprt).CostPerUse = perUse
                        
                        Debug.Print "Notice: " & R.Name; " Already had a PayRate entry in Table '" & tableLetter & "' starting " _
                        & EffDate & ". The Overwrite setting was turn ON so Standard Rate was reset to " & StRate
                        
                        Debug.Print "Notice: " & R.Name; " Already had a PayRate entry in Table '" & tableLetter & "' starting " _
                        & EffDate & ". The Overwrite setting was turn ON so Overtime Rate was reset to " & OverTime
                        
                        Debug.Print "Notice: " & R.Name; " Already had a PayRate entry in Table '" & tableLetter & "' starting " _
                        & EffDate & ". The Overwrite setting was turn ON so CostPerUse was reset to " & perUse
                        
                        prtFound = False
                        Foundprt = 0
                    Else
                        Debug.Print "Notice: " & R.Name; " Already had a PayRate entry in Table '" & tableLetter & "' starting " _
                        & EffDate & ". The Overwrite setting was turn OFF so it was not changed."
                    End If
                    
                'If an existing effective date was NOT found then create the new rate table entry
                Else
                    R.CostRateTables(TableNum).PayRates.Add EffectiveDate:=EffDate, StdRate:=StRate, _
                    OvtRate:=OverTime, CostPerUse:=perUse
                    
                    Debug.Print "Notice: " & R.Name; " now has a PayRate entry in Table '" & tableLetter & "' starting " _
                    & EffDate & " with a Standard Rate of " & StRate & ", Overtime rate of " & OverTime & _
                    ", CostPerUse of " & perUse
                    
                End If
            End If
        
    SkiptoNext:
        Next R
        
        '-------------------------------------------
        Debug.Print " "
        Debug.Print "Run Complete"
        '-------------------------------------------
    End Sub
    


    Brian Kennemer - Project MVP
    DeltaBahn Senior Architect
    endlessly obsessing about Project Server…so that you don’t have to.
    Blog | Twitter | LinkedIn

    Thursday, September 20, 2012 4:48 AM
    Moderator