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

Thread: Compare two versions of a Project file

Thread Tools

Display

Compare two versions of a Project file

Posting Permissions