Help with VBA code to extract information from MsProject to MsExcel

zeni13

New Member
Joined
May 25, 2016
Messages
5
Hey everyone,

I am trying to extract information from project to excel and do this via code. This is something that has to be continuously done as the project rolls on so doing it manually will take too much time. I have posted the code below that I have managed to piece together via perusing the internet, however when I run the code I get the error: " user defined type not defined". Any help is much appreciated, thank you so much in advance :):)

Dim appXL As Excel.Application

Sub StonePlanStatusReport()

Dim t As Task
Dim s As Task

Dim tCurrentFinish As Date
Dim tLastFinish As Date
Dim tCurrentStart As Date
Dim tLastStart As Date

Dim MyWorkbook As Excel.Workbook
Dim mysheetF As Excel.Worksheet
Dim mysheetS As Excel.Worksheet
Dim mysheetC As Excel.Worksheet

Dim SheetrowF As Integer
Dim SheetrowS As Integer
Dim SheetrowC As Integer
Dim mytype As Integer
Dim lastbase As Integer
Dim olderbase As Integer

Dim NewReportCycle As Boolean

'Create the Excel Application
On Error Resume Next
Set appXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set appXL = CreateObject("Excel.<wbr>application")
End If

appXL.Visible = True

Set MyWorkbook = appXL.Workbooks.Add

'find which baseline is later
lastbase = 1
olderbase = 2
If ActiveProject.<wbr>BaselineSavedDate(pjBaseline2) > ActiveProject.<wbr>BaselineSavedDate(pjBaseline1) Then
lastbase = 2
olderbase = 1
End If

mytype = 1 'delayed finish sheet
Set mysheetF = MyWorkbook.Sheets(mytype)
mysheetF.Name = "Delayed Activities - Finish"

Call ExcelTopLine(mysheetF, mytype) 'headers

SheetrowF = 2

mytype = 2 'delayed start sheet
Set mysheetS = MyWorkbook.Sheets.Add
mysheetS.Name = "Delayed Activities - Start"

Call ExcelTopLine(mysheetS, mytype) 'headers

SheetrowS = 2

mytype = 3 'completed activities sheet
Set mysheetC = MyWorkbook.Sheets.Add
mysheetC.Name = "Completed Activities"

Call ExcelTopLine(mysheetC, mytype) 'headers

SheetrowC = 2

'initialise Flag20
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then 'ignore blank lines
t.Flag20 = False
End If
Next t

'check if new report cycle
NewReportCycle = False

If ActiveProject.Tasks(1).Date10 <= ActiveProject.<wbr>BaselineSavedDate(olderbase) Then
NewReportCycle = True
ActiveProject.Tasks(1).Date10 = ActiveProject.<wbr>BaselineSavedDate(lastbase)
End If

'first work out which tasks should be in report
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then 'ignore blank lines
If Not t.Summary Then 'only look at tasks
If t.Flag20 Then 'check if already excluded
For Each s In t.SuccessorTasks
s.Flag20 = True 'so exclude successors
Next s
Else 'if not already excluded, check if replanned
If lastbase = 1 Then
tCurrentStart = t.Baseline1Start
tLastStart = t.Baseline2Start
tCurrentFinish = t.Baseline1Finish
tLastFinish = t.Baseline2Finish
Else
tCurrentStart = t.Baseline2Start
tLastStart = t.Baseline1Start
tCurrentFinish = t.Baseline2Finish
tLastFinish = t.Baseline1Finish
End If
If tCurrentFinish > tLastFinish Or tCurrentStart > tLastStart Then 'replanned, so exclude successors
For Each s In t.SuccessorTasks
s.Flag20 = True 'exclude successors
Next s
End If
End If
End If
End If
Next t

'now do reports
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then 'ignore blank lines
If Not t.Summary Then 'only look at tasks
If Not t.Flag19 Then 'task not previously complete
If t.PercentComplete = 100 Then 'write record to excel sheet
mysheetC.Cells(SheetrowC, 1) = t.ID 'ID
mysheetC.Cells(SheetrowC, 2) = Mid(t.Project, 7) 'project
mysheetC.Cells(SheetrowC, 3) = t.Name & " for " & t.OutlineParent.OutlineParent.<wbr>Name & " for " & t.OutlineParent.Name'description (with summary info)
mysheetC.Cells(SheetrowC, 4) = t.BaselineFinish 'baseline finish
If t.BaselineFinish = "NA" Then 'use Baseline3 if required
mysheetC.Cells(SheetrowC, 4) = t.Baseline3Finish
End If
mysheetC.Cells(SheetrowC, 5) = t.Finish 'finish
For Each s In t.SuccessorTasks
If mysheetC.Cells(SheetrowC, 6) = "" Then
<wbr> mysheetC.Cells(SheetrowC, 6) = s.Name 'successor task names to excel
Else 'append next successor
<wbr> mysheetC.Cells(SheetrowC, 6) = mysheetC.Cells(SheetrowC, 6) & "," & s.Name
End If
Next s
SheetrowC = SheetrowC + 1
If NewReportCycle Then t.Flag19 = True 'set flag for next cycle
End If
End If
If Not t.Flag20 Then 'look for tasks not flagged
'and check if delayed
If lastbase = 1 Then
tCurrentStart = t.Baseline1Start
tLastStart = t.Baseline2Start
tCurrentFinish = t.Baseline1Finish
tLastFinish = t.Baseline2Finish
Else
tCurrentStart = t.Baseline2Start
tLastStart = t.Baseline1Start
tCurrentFinish = t.Baseline2Finish
tLastFinish = t.Baseline1Finish
End If

'check start date first
If tCurrentStart > tLastStart Then 'start delayed, so populate excel sheet with data
mysheetS.Cells(SheetrowS, 1) = t.ID 'ID
mysheetS.Cells(SheetrowS, 2) = Mid(t.Project, 7) 'project
mysheetS.Cells(SheetrowS, 3) = t.Name & " for " & t.OutlineParent.OutlineParent.<wbr>Name & " for " & t.OutlineParent.Name'description (with summary info)
mysheetS.Cells(SheetrowS, 4) = t.BaselineStart 'baseline start
mysheetS.Cells(SheetrowS, 5) = t.Start 'start
mysheetS.Cells(SheetrowS, 6) = t.StartVariance / 480 & " d" 'slippage in days

If t.BaselineStart = "NA" Then 'use Baseline3 if required
t.BaselineStart = t.Baseline3Start
mysheetS.Cells(SheetrowS, 4) = t.BaselineStart 'baseline start
mysheetS.Cells(SheetrowS, 6) = t.StartVariance / 480 & " d" 'slippage in days
t.BaselineStart = "NA"
End If

mysheetS.Cells(SheetrowS, 7) = tLastStart 'previous week's start date
For Each s In t.SuccessorTasks
If mysheetS.Cells(SheetrowS, 8) = "" Then
<wbr> mysheetS.Cells(SheetrowS, 8) = s.Name 'successor task names to excel
Else 'append next successor
<wbr> mysheetS.Cells(SheetrowS, 8) = mysheetS.Cells(SheetrowS, 8) & "," & s.Name
End If
Next s

mysheetS.Cells(SheetrowS, 9) = t.Text19 'mitigation text
mysheetS.Cells(SheetrowS, 10) = t.TotalSlack / 480 & " d" 'float in days
mysheetS.Cells(SheetrowS, 11) = "R" 'status R or A
If t.TotalSlack > 0 Then mysheetS.Cells(SheetrowS, 11) = "A"

SheetrowS = SheetrowS + 1

Else 'start not delayed, so check finish date

If tCurrentFinish > tLastFinish Then 'finish delayed, so populate excel sheet with data
mysheetF.Cells(SheetrowF, 1) = t.ID 'ID
mysheetF.Cells(SheetrowF, 2) = Mid(t.Project, 7) 'project
mysheetF.Cells(SheetrowF, 3) = t.Name & " for " & t.OutlineParent.OutlineParent.<wbr>Name & " for " & t.OutlineParent.Name'description (with summary info)
mysheetF.Cells(SheetrowF, 4) = t.BaselineFinish 'baseline finish
mysheetF.Cells(SheetrowF, 5) = t.Finish 'finish
mysheetF.Cells(SheetrowF, 6) = t.FinishVariance / 480 & " d" 'slippage in days

If t.BaselineFinish = "NA" Then 'use Baseline3 if required
<wbr> t.BaselineFinish = t.Baseline3Finish
<wbr> mysheetF.Cells(SheetrowF, 4) = t.BaselineFinish 'baseline finish
<wbr> mysheetF.Cells(SheetrowF, 6) = t.FinishVariance / 480 & " d" 'slippage in days
<wbr> t.BaselineFinish = "NA"
End If

mysheetF.Cells(SheetrowF, 7) = tLastFinish 'previous week's finish date
For Each s In t.SuccessorTasks
<wbr> If mysheetF.Cells(SheetrowF, 8) = "" Then
<wbr> mysheetF.Cells(SheetrowF, 8) = s.Name 'successor task names to excel
<wbr> Else 'append next successor
<wbr> mysheetF.Cells(SheetrowF, 8) = mysheetF.Cells(SheetrowF, 8) & "," & s.Name
<wbr> End If
Next s

mysheetF.Cells(SheetrowF, 9) = t.Text19 'mitigation text
mysheetF.Cells(SheetrowF, 10) = t.TotalSlack / 480 & " d" 'float in days
mysheetF.Cells(SheetrowF, 11) = "R" 'status R or A
If t.TotalSlack > 0 Then mysheetF.Cells(SheetrowF, 11) = "A"

SheetrowF = SheetrowF + 1
End If
End If
End If
End If
End If
Next t

mysheetF.Columns.AutoFit
mysheetS.Columns.AutoFit
mysheetC.Columns.AutoFit

AppActivate "Microsoft Project"
MsgBox ("Report Complete")
AppActivate "Microsoft Excel"

End Sub



Private Sub ExcelTopLine(mysheet As Excel.Worksheet, mytype As Integer)


'Excel Titles
mysheet.Cells(1, 1) = "ID"
mysheet.Cells(1, 2) = "Workstream"
mysheet.Cells(1, 3) = "Activity Description"
mysheet.Cells(1, 4) = "Baseline Start Date"
mysheet.Cells(1, 5) = "Revised Start Date"
If mytype = 1 Then
mysheet.Cells(1, 4) = "Baseline Finish Date"
mysheet.Cells(1, 5) = "Revised Finish Date"
ElseIf mytype = 3 Then
mysheet.Cells(1, 4) = "Planned Finish Date"
mysheet.Cells(1, 5) = "Actual Finish Date"
End If
If mytype < 3 Then
mysheet.Cells(1, 6) = "Slippage from Orig. Baseline"
mysheet.Cells(1, 7) = "Last Week's Finish Date"
If mytype = 2 Then mysheet.Cells(1, 7) = "Last Week's Start Date"
mysheet.Cells(1, 8) = "Impacted Successor"
mysheet.Cells(1, 9) = "Actions to mitigate"
mysheet.Cells(1, 10) = "Float"
mysheet.Cells(1, 11) = "Status"
Else
mysheet.Cells(1, 6) = "Impacted Successor"
End If

appXL.DisplayAlerts = False

With mysheet.Range("A1:K1")
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
.Font.Bold = True
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

appXL.DisplayAlerts = True

mysheet.Columns("D:E").<wbr>NumberFormat = "dd/mm/yyyy"
If mytype < 3 Then mysheet.Columns("G:G").<wbr>NumberFormat = "dd/mm/yyyy"

End Sub

Kind regards

Zeni
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,910
error: " user defined type not defined".
Code:
[FONT=Calibri]Dim appXL As Excel.Application[/FONT]
Which line causes the error?

Just a guess: since you are using named Excel classes, as in the line above, is there a reference to Microsoft Excel nn.0 Object Library in Tools -> References in the VBA editor?

Please use CODE tags - click the # icon in the message editor.
 
Last edited:

Forum statistics

Threads
1,137,354
Messages
5,681,002
Members
419,948
Latest member
Sbakker1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top