Importing resource availability from Excel

[jensmaigaard]

Hi,

Now here's a challenge...

Where I am, resource availability is scattered, ie. people are allocated to projects on and off for a few days at a time over the duration of the project. Entering this into the resource availability dialogue manually every time bookings are updated is error prone and time consuming.

I can get my bookings massaged into this format in Excel:

<ressource name> <from date> <to date>
<ressource name> <from date> <to date>
...

With as many lines per ressouce as necessary (one per period). Now, if I import this into project 2007, i get one ressource item per line in excel, i.e. a lot of duplicates. Of course I haven't got 10 copies of the same person, I have the same person 10 times, ie. 10 pairs of "available from" and "available to" on the same person. The from and to dates are not imported at all.

Any ideas on how to get this to work? I have been using the resource name as the merge key, but no luck so far.

Thanks a lot,

Jens

 

[PDQBach]

I don't know of any easy way to do this (but Project is a feature rich environment so it's always possible).

I _think_ it will take some VBA (and probably non-trivial VBA) but, again, Project is a feature rich environment.

It seems to me (as I read your question) that when you get those dates, you enter the information by:

view | Resource sheet
Double click on a resource
Click on the General tab
enter the data in the Resource Availability display in the lower left

Is that correct? Or do you use a different approach?

Please advise. Thanks.

 

[jensmaigaard]

Yes - that's exactly how I do it when I enter the dates manually (e.g. 5 ressources * 15 periods... sigh)

/jens

 

[PDQBach]

Try this project vba macro. On the spreadsheet, col1 must have a name that is in the project; col2 must have a valid start date; col3 must have a valid end date.

I don't know (didn't test!) what happens if there is an overlap in the date ranges -- or a lot of other tests. In other words, if the data is valid, this will work. If it isn't valid, I have no idea what will happen.

Watch out for linewraps.

Sub PDQBach()
Dim msXLapp As Object

Dim tsk As Task
Dim res As Resource
Dim asgn As Assignment

Dim lngLastRow As Long, lngLastCol As Long, lngCntRow As Long
Dim lngResID As Long

Dim FilesToOpen As Variant

Dim strFullFileName As String
On Error Resume Next

If msXLapp Is Nothing Then
Set msXLapp = GetObject(, "Excel.Application")
If Err.Number = 0 Then
msXLapp.Application.Quit
Set msXLapp = Nothing
Set msXLapp = CreateObject("Excel.Application")
Else
Set msXLapp = CreateObject("Excel.Application")
End If
End If

msXLapp.Application.Visible = True
FilesToOpen = msXLapp.GetOpenFilename("Text Files (*.xls), *.xls")
If FilesToOpen = False Then
End
End If
msXLapp.Application.workbooks.Open FilesToOpen
msXLapp.Sheets(msXLapp.Sheets.Count).Activate
lngLastRow = cells.SpecialCells(xlLastCell).Row
lngLastCol = cells.SpecialCells(xlLastCell).Column

'loop through each row in spreadsheet
For lngCntRow = 1 To lngLastRow
lngResID = ActiveProject.Resources(CStr(msXLapp.cells(lngCntRow, 1))).ID
If ActiveProject.Resources(lngResID).Availabilities(1).AvailableFrom = #1/1/1984# Or ActiveProject.Resources(lngResID).Availabilities(1).AvailableTo = #12/31/2049# Then
ActiveProject.Resources(lngResID).Availabilities(1).AvailableFrom = CDate(msXLapp.cells(lngCntRow, 2))
ActiveProject.Resources(lngResID).Availabilities(1).AvailableTo = CDate(msXLapp.cells(lngCntRow, 3))
ActiveProject.Resources(lngResID).Availabilities(1).AvailableUnit = 100
Else
On Error Resume Next
ActiveProject.Resources(lngResID).Availabilities.Add CDate(msXLapp.cells(lngCntRow, 2)), CDate(msXLapp.cells(lngCntRow, 3)), CDbl("100.0")
On Error GoTo 0
End If
Next
MsgBox "Finished"
End Sub

 

[jensmaigaard]

Thanks a lot for the effort! I'm impressed...

Unfortunately, it seems I can't get it to work. It comes as far as the "finished" prompt, but no dates are imported. Could it have something to do with my regional settings being danish, ie. date format confusion?

I suppose I'll have to do some debugging. Thanks a lot again for getting me started

Jens

 

[jensmaigaard]

Looking at it more closely, it seems the

For lngCntRow = 1 To lngLastRow

loop doesn't run, ie. the below doesn't produce an msgbox:

'loop through each row in spreadsheet
For lngCntRow = 1 To lngLastRow
MsgBox ("test")
lngResID = ActiveProject.Resources(CStr(msXLapp.cells(lngCntRow, 1))).ID

If ActiveProject.Resources(lngResID).Availabilities(1).AvailableFrom = #1/1/1984# Or ActiveProject.Resources(lngResID).Availabilities(1).AvailableTo = #12/31/2049# Then
ActiveProject.Resources(lngResID).Availabilities(1).AvailableFrom = CDate(msXLapp.cells(lngCntRow, 2))
ActiveProject.Resources(lngResID).Availabilities(1).AvailableTo = CDate(msXLapp.cells(lngCntRow, 3))
ActiveProject.Resources(lngResID).Availabilities(1).AvailableUnit = 100
Else
On Error Resume Next
ActiveProject.Resources(lngResID).Availabilities.Add CDate(msXLapp.cells(lngCntRow, 2)), CDate(msXLapp.cells(lngCntRow, 3)), CDbl("100.0")
On Error GoTo 0
End If
Next

 

[PDQBach]

You've probably got an old version of Excel -- instead of letting the macro calculate the last row number, enter it directly.

Instead of:
lngLastRow = cells.SpecialCells(xlLastCell).Row

put:
lngLastRow = 37 ' or whatever the last row used is.

 

[PDQBach]

or

Start project
Alt+F11 to display the VBA screen
Tools > References and make sure there is a checkmark next to "Microsoft Office 11.0 Object Library"

It took me a bit to write the code but it works just fine.

 

[jensmaigaard]

I enabled the "Microsoft Excel 12 object library" in references - that worked!

Thanks a lot, I am thoroughly impressed. Can't wait to show my colleagues tomorrow

/Jens

 

[jensmaigaard]

I can't get over how great this is. Now, getting frisky, I'd like to add a final touch:

Whenever I use this, I need to make sure I start over, i.e. I'm importing everything, so I need to clean up before doing so. If not, I'll end up with a mess because some periods in the .mpp are no longer valid as the resource reservations have been cancelled.

Is there an easy bit of code to add that will make it start out by deleting all available from/to pairs from all resources in the .mpp?

Thanks again,

Jens

 

[PDQBach]

You do realize they pay me big bucks to know this stuff.

Place this anywhere logical:

dim iLoop as integer
For Each res In ActiveProject.Resources
For iLoop = res.Availabilities.Count To 1 Step -1
res.Availabilities(iLoop).Delete
Next
Next

 

[erikko]

transporting files for Excel is a painstaking task for me good thing i followed your tips here

http://hilogic.net/

http://www.fiscal-wise.com.my/