Skip to main content
added 103 characters in body
Source Link
Joop Eggen
  • 4.7k
  • 15
  • 19

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
        If ActiveProject.Tasks(Temp).Flag5 <> 1 Then
            text30 = ActiveProject.Tasks(Temp).Text30;
            For Temp2 = Temp + 1 To ActiveProject.Tasks.Count
                If ActiveProject.Tasks(Temp2).Flag5 <> 1
                        And text30 = ActiveProject.Tasks(Temp2).Text30 Then
                    ActiveProject.Tasks(Temp).Flag5 = 1
                    ActiveProject.Tasks(Temp2).Flag5 = 1
                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.

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
        text30 = ActiveProject.Tasks(Temp).Text30;
        For Temp2 = Temp + 1 To ActiveProject.Tasks.Count
            If ActiveProject.Tasks(Temp2).Flag5 <> 1
                    And text30 = ActiveProject.Tasks(Temp2).Text30 Then
                ActiveProject.Tasks(Temp).Flag5 = 1
                ActiveProject.Tasks(Temp2).Flag5 = 1
            End If
        Next Temp2
        '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.

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
        If ActiveProject.Tasks(Temp).Flag5 <> 1 Then
            text30 = ActiveProject.Tasks(Temp).Text30;
            For Temp2 = Temp + 1 To ActiveProject.Tasks.Count
                If ActiveProject.Tasks(Temp2).Flag5 <> 1
                        And text30 = ActiveProject.Tasks(Temp2).Text30 Then
                    ActiveProject.Tasks(Temp).Flag5 = 1
                    ActiveProject.Tasks(Temp2).Flag5 = 1
                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.

Source Link
Joop Eggen
  • 4.7k
  • 15
  • 19

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
        text30 = ActiveProject.Tasks(Temp).Text30;
        For Temp2 = Temp + 1 To ActiveProject.Tasks.Count
            If ActiveProject.Tasks(Temp2).Flag5 <> 1
                    And text30 = ActiveProject.Tasks(Temp2).Text30 Then
                ActiveProject.Tasks(Temp).Flag5 = 1
                ActiveProject.Tasks(Temp2).Flag5 = 1
            End If
        Next Temp2
        '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.