# Find duplicated text for tasks in MS Project

My code in MS project VBA, in theory, doesn't do anything major.
It compares the tasks with each other, but it runs super slow.

One run through Temp lasts 15 secs. Try that with 1500-2000 tasks and the macro takes hours.

Sub Laczona()

Application.Calculation = xlManual
Application.ScreenUpdating = False

Dim Temp, Temp2 As Integer

For Temp = 1 To ActiveProject.Tasks.Count

For Temp2 = 1 To ActiveProject.Tasks.Count

If Temp <> Temp2 Then
End If
End If

Next Temp2
MsgBox "Praca: " & Temp
Next Temp

MsgBox "Prace Laczone Uzupelnione"
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub


The code runs in MS Project 2013. Its purpose is to check whether two tasks have the same text in field Text30. If that is the case, the code sets flag5 to 1.

• You have two loops, so 1500 * 1500 or 2000 * 2000 = 2,250,000 to 4,000,000 iterations. – BigBen Feb 13 at 14:15
• Indeed, but shouldn't 4mil operations be a breeze for a 2,4 ghz processor? – Marcin Feb 13 at 14:17

In a slightly different implementation from @FreeFlow's answer, this code also uses a Dictionary but it builds a list of duplicate tasks for each Text30 value. Then uses that task list to set Flag5. Tested on a very large project (>1100 tasks) it runs in less than 15 seconds.

Option Explicit

Sub CheckForDuplicates()

Application.Calculation = pjManual
Application.ScreenUpdating = False

Dim text30values As Dictionary
Set text30values = New Dictionary

With ActiveProject
'--- for each of the text30 values, create a list of tasks that contain
'    each value. For example, if "abc" appears in tasks 17,18,23, and 50
Dim i As Long
For i = 1 To .Tasks.Count
Else
End If
End If
Next i

'--- now run through each entry and set the flag field for the duplicates
'    entries with duplicates will be CSV lists, so we're looking for a comma
For i = 0 To text30values.Count - 1
If InStr(1, taskList, ",") > 0 Then
Dim j As Long
Next j
End If
Next i
End With

Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
End Sub

• Works! Nice thank You. – Marcin Feb 17 at 12:08

If I understand correctly, you are testing to see if there are any duplicate entries in Text30 and if you find a duplicate setting flag 5 to 1.

In this case you are duplicating at least half of the tests that you are conducting because Task(1).Text(30) = Task(2).Text30 is the same comparison as Tasks(2).Text30 = Task(1).Text30.

So you can cut down on the number of tests that you do by eliminating tests that you have already performed. This is done by starting the inner loop at the current value of the outer loop.

e.g.

For Temp2 = 1 To ActiveProject.Tasks.Count


should be revised to

For Temp2 = Temp To ActiveProject.Tasks.Count


However an even quicker way would be to use a Scripting.Dictionary. I don't have project installed on my PC but even so if the code below doesn't work it should at least point you in the right direction

Sub Lacunza()

Dim myUniqueText30 As Scripting.Dictionary
Set myUniqueText30 = New Scripting.Dictionary

If myUniqueText30.Exists(.Text30) Then

.Flag5 = 1

Else

End If

Next

' As this point you have a scripting dictionary which will return the task id
' where the first occurence of a particular Text30 value was found.

End Sub


I am not familiar with Project VBA, but wouldn't it be much faster to use filters and iterate that instead?

Filters object

IOW, don't try to brute-solve it. Learn the object model and find the object/method that will help you do it since their implementation will be much faster than any loops you come up with, on average.

An immediately obvious improvement would be to start the inner loop from Temp+1.

Sub Laczona()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Dim Temp, Temp2 As Integer
Dim text30 As String
For Temp = 1 To ActiveProject.Tasks.Count
For Temp2 = Temp + 1 To ActiveProject.Tasks.Count
End If
Next Temp2
End If
'MsgBox "Praca: " & Temp
Next Temp
MsgBox "Prace Laczone Uzupelnione"
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub


Still quadratic complexity. Sorting on Text30 would really improve the speed, but whether that is feasible; you would need an extra index etcetera I do not know.

Above I checked Flag5 too, as that might be faster - or just as likely not.

MsgBox in a loop probably was only for testing.