PDA

View Full Version : [SOLVED] Compare two versions of a Project file



onetruerick
12-07-2008, 07:22 PM
At one point or another, most Project users end up having to compare two Project files to find the differences. This can be a pain in the neck if you have to do it line by line. And writing a macro to do it is no fun either. So, don't do either one - use this macro already finished and tested. It creates a comparison file in Excel and highlights the differences in red. To install it, copy the code into a new module and add a reference to the Excel Object Library. Then load the oldest of the two files to be compared, and then the later one. Then start the macro and sit back until it finishes. Comparing two files has never been easier!

Here it is - enjoy! Send me your comments or suggestions, please!


Sub CompareTwoProjectFiles()
'This VBA macro for Project was written by Rick Williams
Dim x As Integer
Dim First As Tasks
Dim Second As Tasks
Dim UniqueVal As String
Dim Match(100000) As Boolean
Dim Deletes(100000) As String
Dim NumDeletes As Integer
Dim Adds(100000) As String
Dim NumAdds As Integer
Dim Changes(100000) As Integer
Dim UniqueIdentifier As String
Dim OrigFile As String
Dim NewFile As String
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim XLSheet As Excel.Worksheet
Dim oTask As Task
Dim i As Long
x = Application.Projects.Count
If x <> 2 Then
MsgBox "You must have two projects open to execute a comparison. You have " & x & " open at this time."
Exit Sub
Else
OrigFile = Application.Projects(1).Path & "\" & Application.Projects(1).Name
NewFile = Application.Projects(2).Path & "\" & Application.Projects(2).Name
UniqueIdentifier = InputBox("Which field uniquely identifies tasks?", "Input Unique Identifier", "UniqueID")
Set xlApp = CreateObject("Excel.Application", "")
xlApp.Visible = False
xlApp.Workbooks.Add
Set xlWorkBook = xlApp.ActiveWorkbook
Set XLSheet = xlApp.ActiveSheet
xlApp.Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = "Comparison between project " & OrigFile & " (Project 1) and " & NewFile & " (Project 2)"
xlApp.Range("A6").Select
xlApp.ActiveCell.FormulaR1C1 = "Project"
xlApp.Range("B6").Select
xlApp.ActiveCell.FormulaR1C1 = "Task"
xlApp.Range("C6").Select
xlApp.ActiveCell.FormulaR1C1 = "Name"
xlApp.Range("D6").Select
xlApp.ActiveCell.FormulaR1C1 = "WBS"
xlApp.Range("E6").Select
xlApp.ActiveCell.FormulaR1C1 = "Duration"
xlApp.Range("F6").Select
xlApp.ActiveCell.FormulaR1C1 = "Preds"
xlApp.Range("G6").Select
xlApp.ActiveCell.FormulaR1C1 = "ES"
xlApp.Range("H6").Select
xlApp.ActiveCell.FormulaR1C1 = "EF"
xlApp.Range("I6").Select
xlApp.ActiveCell.FormulaR1C1 = "BaselineWork"
xlApp.Range("J6").Select
xlApp.ActiveCell.FormulaR1C1 = "BaselineCost"
xlApp.Range("K6").Select
xlApp.ActiveCell.FormulaR1C1 = "Work"
xlApp.Range("L6").Select
xlApp.ActiveCell.FormulaR1C1 = "Cost"
xlApp.ActiveCell.Offset(1, -11).Range("A1").Select
Set First = Application.Projects(1).Tasks
Set Second = Application.Projects(2).Tasks
Select Case UniqueIdentifier
Case "UniqueID"
For Each Task In First
If Not (Task Is Nothing) Then
UniqueVal = Trim(Task.UniqueID)
xlApp.ActiveCell.FormulaR1C1 = "1"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = UniqueVal
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Name
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.WBS
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (Task.Duration / 480)
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Predecessors
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.BaselineWork
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.BaselineCost
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Work
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Cost
' XLApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.Offset(1, -11).Range("A1").Select
For Each oTask In Second
If Not (oTask Is Nothing) Then
If Trim(oTask.UniqueID) = UniqueVal Then
xlApp.ActiveCell.FormulaR1C1 = "2"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
Match(Task.UniqueID) = True
xlApp.ActiveCell.FormulaR1C1 = oTask.UniqueID
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Name
If oTask.Name <> Task.Name Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.WBS
If oTask.WBS <> Task.WBS Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (oTask.Duration / 480)
If oTask.Duration <> Task.Duration Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Predecessors
If oTask.Predecessors <> Task.Predecessors Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyStart
If oTask.EarlyStart <> Task.EarlyStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyFinish
If oTask.EarlyFinish <> Task.EarlyFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.BaselineWork
If oTask.BaselineWork <> Task.BaselineWork Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.BaselineCost
If oTask.BaselineCost <> Task.BaselineCost Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Work
If oTask.Work <> Task.Work Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Cost
' XLApp.ActiveCell.Offset(0, 1).Range("A1").Select
If oTask.Cost <> Task.Cost Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(1, -11).Range("A1").Select
End If
End If
Next
If Not Match(Task.UniqueID) Then
NumDeletes = NumDeletes + 1
Deletes(NumDeletes) = Task.UniqueID
End If
End If
Next
For Each Task In Second
If Not (Task Is Nothing) Then
UniqueVal = Trim(Task.UniqueID)
For Each oTask In First
If Not (oTask Is Nothing) Then
If Trim(oTask.UniqueID) = UniqueVal Then
Match(Task.UniqueID) = True
End If
End If
Next
If Not Match(Task.UniqueID) Then
NumAdds = NumAdds + 1
Adds(NumAdds) = Task.UniqueID
End If
End If
Next
Case "Text1"
For Each Task In First
UniqueVal = Trim(Task.Text1)
xlApp.ActiveCell.FormulaR1C1 = "1"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = UniqueVal
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Name
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.WBS
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (Task.Duration / 480)
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Predecessors
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.LateStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.LateFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.FreeSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.TotalSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.Offset(1, -12).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = "2"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
For Each oTask In Second
If Trim(oTask.Text1) = UniqueVal Then
Match(Task.Text1) = True
xlApp.ActiveCell.FormulaR1C1 = oTask.Text1
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Name
If oTask.Name <> Task.Name Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.WBS
If oTask.WBS <> Task.WBS Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (oTask.Duration / 480)
If oTask.Duration <> Task.Duration Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Predecessors
If oTask.Predecessors <> Task.Predecessors Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyStart
If oTask.EarlyStart <> Task.EarlyStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyFinish
If oTask.EarlyFinish <> Task.EarlyFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.LateStart
If oTask.LateStart <> Task.LateStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.LateFinish
If oTask.LateFinish <> Task.LateFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.FreeSlack
If oTask.FreeSlack <> Task.FreeSlack Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.TotalSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
If oTask.TotalSlack <> Task.TotalSlack Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.Text1) = Changes(Task.Text1) + 1
End If
End If
Next
If Not Match(Task.Text1) Then
NumDeletes = NumDeletes + 1
Deletes(NumDeletes) = Task.Text1
End If
xlApp.ActiveCell.Offset(1, -12).Range("A1").Select
Next
For Each Task In Second
UniqueVal = Trim(Task.Text1)
For Each oTask In First
If Trim(oTask.Text1) = UniqueVal Then
Match(Task.Text1) = True
End If
Next
If Not Match(Task.Text1) Then
NumAdds = NumAdds + 1
Adds(NumAdds) = Task.Text1
End If
Next
Case "ID"
For Each Task In First
If Not (Task Is Nothing) Then
UniqueVal = Trim(Task.UniqueID)
xlApp.ActiveCell.FormulaR1C1 = "1"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = UniqueVal
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Name
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.WBS
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (Task.Duration / 480)
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Predecessors
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.LateStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.LateFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.FreeSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.TotalSlack
' XLApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.Offset(1, -11).Range("A1").Select
For Each oTask In Second
If Not (oTask Is Nothing) Then
If Trim(oTask.UniqueID) = UniqueVal Then
xlApp.ActiveCell.FormulaR1C1 = "2"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
Match(Task.UniqueID) = True
xlApp.ActiveCell.FormulaR1C1 = oTask.UniqueID
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Name
If oTask.Name <> Task.Name Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.WBS
If oTask.WBS <> Task.WBS Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (oTask.Duration / 480)
If oTask.Duration <> Task.Duration Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Predecessors
If oTask.Predecessors <> Task.Predecessors Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyStart
If oTask.EarlyStart <> Task.EarlyStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyFinish
If oTask.EarlyFinish <> Task.EarlyFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.LateStart
If oTask.LateStart <> Task.LateStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.LateFinish
If oTask.LateFinish <> Task.LateFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.FreeSlack
If oTask.FreeSlack <> Task.FreeSlack Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.TotalSlack
' XLApp.ActiveCell.Offset(0, 1).Range("A1").Select
If oTask.TotalSlack <> Task.TotalSlack Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.UniqueID) = Changes(Task.UniqueID) + 1
End If
xlApp.ActiveCell.Offset(1, -11).Range("A1").Select
End If
End If
Next
If Not Match(Task.UniqueID) Then
NumDeletes = NumDeletes + 1
Deletes(NumDeletes) = Task.UniqueID
End If
End If
Next
For Each Task In Second
If Not (Task Is Nothing) Then
UniqueVal = Trim(Task.UniqueID)
For Each oTask In First
If Not (oTask Is Nothing) Then
If Trim(oTask.UniqueID) = UniqueVal Then
Match(Task.UniqueID) = True
End If
End If
Next
If Not Match(Task.UniqueID) Then
NumAdds = NumAdds + 1
Adds(NumAdds) = Task.UniqueID
End If
End If
Next
Case "WBS"
For Each Task In First
UniqueVal = Trim(Task.WBS)
xlApp.ActiveCell.FormulaR1C1 = "1"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = UniqueVal
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Name
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.WBS
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (Task.Duration / 480)
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.Predecessors
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.EarlyFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.LateStart
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.LateFinish
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.FreeSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Task.TotalSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.Offset(1, -12).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = "2"
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
For Each oTask In Second
If Trim(oTask.WBS) = UniqueVal Then
Match(Task.WBS) = True
xlApp.ActiveCell.FormulaR1C1 = oTask.WBS
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Name
If oTask.Name <> Task.Name Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.WBS
If oTask.WBS <> Task.WBS Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = (oTask.Duration / 480)
If oTask.Duration <> Task.Duration Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.Predecessors
If oTask.Predecessors <> Task.Predecessors Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyStart
If oTask.EarlyStart <> Task.EarlyStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.EarlyFinish
If oTask.EarlyFinish <> Task.EarlyFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.LateStart
If oTask.LateStart <> Task.LateStart Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.LateFinish
If oTask.LateFinish <> Task.LateFinish Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.FreeSlack
If oTask.FreeSlack <> Task.FreeSlack Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = oTask.TotalSlack
xlApp.ActiveCell.Offset(0, 1).Range("A1").Select
If oTask.TotalSlack <> Task.TotalSlack Then
xlApp.ActiveCell.Select
With xlApp.Selection.Font
.FontStyle = "Bold"
.ColorIndex = 46
End With
Changes(Task.WBS) = Changes(Task.WBS) + 1
End If
End If
Next
If Not Match(Task.WBS) Then
NumDeletes = NumDeletes + 1
Deletes(NumDeletes) = Task.WBS
End If
xlApp.ActiveCell.Offset(1, -12).Range("A1").Select
Next
For Each Task In Second
UniqueVal = Trim(Task.WBS)
For Each oTask In First
If Trim(oTask.WBS) = UniqueVal Then
Match(Task.WBS) = True
End If
Next
If Not Match(Task.WBS) Then
NumAdds = NumAdds + 1
Adds(NumAdds) = Task.WBS
End If
Next
End Select
End If
If NumAdds > 0 Then
xlApp.ActiveCell.Offset(2, 1).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = "Tasks Added"
xlApp.ActiveCell.Offset(1, 0).Range("A1").Select
For i = 1 To NumAdds
xlApp.ActiveCell.FormulaR1C1 = "Task " & Adds(i) & " was added."
xlApp.ActiveCell.Offset(1, 0).Range("A1").Select
Next i
End If
If NumDeletes > 0 Then
xlApp.ActiveCell.Offset(2, 0).Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = "Tasks Deleted"
xlApp.ActiveCell.Offset(1, 0).Range("A1").Select
For i = 1 To NumDeletes
xlApp.ActiveCell.FormulaR1C1 = "Task " & Deletes(i) & " was deleted."
xlApp.ActiveCell.Offset(1, 0).Range("A1").Select
Next i
End If
Set First = Nothing
Set Second = Nothing
xlApp.Visible = True
End Sub

SoftwareMatt
06-29-2009, 03:58 AM
Nice code - thank you.

Oorang
06-29-2009, 09:18 AM
Comment = "Wow I'll have to look at that in more depth.":)
Suggestion = "Use Trim$ instead of Trim, it runs faster."

Seriously though, you should make this a KBase Entry. Do you know how to do that?

HDeinhammer
02-15-2022, 07:58 AM
I know this thread is quite dated, but I stumbled across the above macro and have brushed it up a little to run faster and. Thanks to the original author and my code is below (You need the Sub and the function).
Hope this helps,
Harald



Sub Compare2ProjectFiles()
Dim intPjCount As Integer
Dim pj1 As Tasks
Dim pj2 As Tasks
Dim OrigFile As String
Dim NewFile As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rOut As Excel.Range
Dim Cell As Excel.Range
Dim intCount As Integer
Dim blnIsDifferent As Boolean
Dim strPath As String
Dim strFileName As String
Dim t1 As Task, t2 As Task
Dim blnTaskMatch As Boolean
Dim arrP1() As Variant
Dim arrP2() As Variant
intPjCount = Application.Projects.Count
If intPjCount <> 2 Then
MsgBox "You must have two projects open to execute a comparison. You have " & intPjCount & " open at this time."
Exit Sub
End If
OrigFile = Application.Projects(1).Path & "" & Application.Projects(1).Name
NewFile = Application.Projects(2).Path & "" & Application.Projects(2).Name
Set pj1 = Application.Projects(1).Tasks
Set pj2 = Application.Projects(2).Tasks
'Open an empty Excel sheet
Set xlApp = CreateObject("Excel.Application") 'New Excel.Application
xlApp.Visible = False
xlApp.Workbooks.Add
Set xlBook = xlApp.ActiveWorkbook
Set xlSheet = xlApp.ActiveSheet
'Header
With xlSheet
.Range("A1") = "Comparison between two project files (P1 and P2)"
.Rows("1:1").Style = "Heading 1"
.Range("A2") = "Created on " & Format(Now(), "dd/mm/yyyy") & " by " & Environ("username")
.Range("A4") = "P1: " & OrigFile
.Range("A5") = "P2: " & NewFile
Set rOut = .Range("A7").Resize(1, 13)
rOut = Array("Project", "ID", "Task Name", "WBS", "Dur(d)", "Successors", "Predecessors", "Start", "Finish", "BaselineWork", "BaselineCost", "Work", "Cost")
rOut.Font.Bold = True
Set rOut = rOut.Offset(1, 0)
For Each t1 In pj1
Application.StatusBar = "Comparing task " & t1.ID: DoEvents
'xlApp.StatusBar = "Processing task " & t1.ID: DoEvents
'Write key data into an array
arrP1() = AddTaskDataToArray(t1, "P1")
blnTaskMatch = False
For Each t2 In pj2
If t1.UniqueID = t2.UniqueID Then
arrP2 = AddTaskDataToArray(t2, "P2")
blnTaskMatch = True
Exit For
End If
Next t2
'Task of P1 not found in P2
If blnTaskMatch = False Then
rOut.Resize(1, 1) = "Task deleted: " & t1.WBS & " - " & t1.Name
rOut.Interior.ColorIndex = 3
Set rOut = rOut.Offset(2, 0)
'Write out if different
Else
blnIsDifferent = False
For intCount = LBound(arrP1) + 1 To UBound(arrP1)
If arrP1(intCount) <> arrP2(intCount) And intCount <> 3 Then 'Exclude the WBS number from the comparison
blnIsDifferent = True
End If
Next intCount
If blnIsDifferent Then
rOut = arrP1
rOut.Offset(1, 0) = arrP2
For Each Cell In rOut.Offset(0, 1)
If Cell <> Cell.Offset(1, 0) Then Cell.Offset(1, 0).Interior.ColorIndex = 6
Next Cell
Set rOut = rOut.Offset(3, 0)
End If
End If
Next t1
'Find added tasks
blnTaskMatch = False
For Each t2 In pj2
Application.StatusBar = "Checking for added tasks " & t2.ID
For Each t1 In pj1
If t1.UniqueID = t2.UniqueID Then
blnTaskMatch = True
End If
Next t1
If blnTaskMatch = False Then
rOut.Resize(1, 1) = "Task added: " & t2.WBS & " - " & t2.Name
rOut.Interior.ColorIndex = 4
Set rOut = rOut.Offset(2, 0)
End If
blnTaskMatch = False
Next t2
.Columns("A:L").AutoFit
.Columns("A:B").ColumnWidth = 7
.Columns("C:C").ColumnWidth = 50
.Columns("F:G").ColumnWidth = 20
End With
Set pj1 = Nothing
Set pj2 = Nothing
Set xlSheet = Nothing
Application.StatusBar = "Storing file on desktop ..."
strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & ""
strFileName = Format(Now(), "yyyy-mm-dd hh-mm") & " Project file comparison"
xlBook.SaveAs strPath & strFileName
Application.StatusBar = False
If MsgBox("All done, file saved to desktop as " & vbCrLf & strFileName & vbCrLf & "Do you want to open it now?", vbYesNo) = vbYes Then
xlApp.Quit
Set xlApp = Nothing
Application.StatusBar = False
CreateObject("Shell.Application").Open (strPath & strFileName & ".xlsx")
End If
End Sub

Function AddTaskDataToArray(t As Task, strProjectID As String) As Variant()
Dim arrResult(0 To 12) As Variant
arrResult(0) = strProjectID
arrResult(1) = t.ID
arrResult(2) = t.Name
arrResult(3) = t.WBS
arrResult(4) = t.Duration / 480
arrResult(5) = CStr(t.Successors)
arrResult(6) = CStr(t.Predecessors)
arrResult(7) = t.Start
arrResult(8) = t.Finish
arrResult(9) = t.BaselineWork
arrResult(10) = t.BaselineCost
arrResult(11) = t.Work
arrResult(12) = t.Cost
AddTaskDataToArray = arrResult
End Function

SamT
02-19-2022, 01:27 PM
HDeinHammer, you, too, should look into our KB submissions