VBA to Escalate Resource Rates

[John4bank]

I have developed some different VBA scripts for Project, but I am stuck in
the development of one for a project that I am working on.

I am trying to escalate the rates of every resource on my resource sheet by
4% on March 20, 2010. I have the looping structure setup, but I am not sure
how to get it to enter "3/20/10" in the "Effective Date" and "4%" in the
"Standard Rate" of the first blank row after my original rates.

Does anyone have any idea on how to write VBA to edit things on the
"Resource Information" screen within Project?

Thanks for your help.

Sincerely,

John

 

[JulieS]

Hi John,

Try the following snippet of code:

Sub IncreaseRates()
Dim Rsr As Resource
For Each Rsr In ActiveProject.Resources
Rsr.CostRateTables("A").PayRates.Add "3/20/2010", "1.4%", "1.4%", "0"
Next Rsr
End Sub

The code assumes you have the current cost rates in the "A" cost rate
table for each resource.

I hope this helps. Let us know how you get along.

Julie
Project MVP

Visit http://project.mvps.org/ for the FAQs and additional
information about Microsoft Project

 

[John4bank]

I changed it from 1.4% to 4% in your code, other than that it works
perfectly. Now I just need to meld into it a little code to leave out
resources under a certain value, and this is good to go.

Thanks so much.

 

[John4bank]

Ok I got your code to work just how I wanted it to, but I am running into a
problem when I try to get it to only escalate work and not materials or Cost.

Does anyone know how to modify this code so it only escalates "Work" in the
"Type" field?

Thanks for your help.

Here are my changes to your code:

Sub IncreaseRates()
Dim Rsr As Resource
Dim MRsr As Resources
Dim iDate As Date
Dim Pincrease As String
Set MRsr = ActiveProject.Resources
'input box to ask the user to enter the date of pay increase
iDate = InputBox("Please enter the date the increase should take affect.",
"Date Input", "mm/dd/yyyy")
'input box to ask the user to enter percent increase
Pincrease = InputBox("Please enter the percent of the increase.", "Percent
Input", "#% i.e. 4%")
For Each Rsr In MRsr
Rsr.CostRateTables("A").PayRates.Add iDate, Pincrease, Pincrease, "0"
Next Rsr
End Sub

 

[John4bank]

I actually figured it out...see my code below:

Sub IncreaseRates()

Dim Rsr As Resource
Dim MRsr As Resources
Dim iDate As Date
Dim Pincrease As String
Dim y As String

Set MRsr = ActiveProject.Resources

'input box to ask the user to enter the date of pay increase
iDate = InputBox("Please enter the date the increase should take affect.",
"Date Input", "mm/dd/yyyy")
'input box to ask the user to enter percent increase
Pincrease = InputBox("Please enter the percent of the increase.", "Percent
Input", "#% i.e. 4%")

For Each Rsr In MRsr
y = 102
p = Rsr.ID
SelectRow p, rowrelative:=False
SelectResourceField Row:=p, rowrelative:=False, Column:="Type"
y = ActiveCell.Text
If "Work" = y Then
Rsr.CostRateTables("A").PayRates.Add iDate, Pincrease, Pincrease, "0"
End If
Next Rsr
End Sub

 

[JulieS]

You're most welcome John and thank you for the feedback. I'm glad to
see you got your other questions worked out as well.

Julie