Optimize MS Project VBA Macro

I have a macro that I am currently running to remove tasks from a project plan that a) have zero work effort and b) aren't key milestone tasks, which is a custom field that we have added.

At the time that the macro runs, there are approximately 1850 rows in the project plan that the macro executes againt to remove the tasks, and the current run time can be upwards of 20 minutes (on average, about 15 minutes). While the macro will successfully execute each time, I am looking for ways to optimize the code to reduce run time. From the research I've done to date, I am not able to figure out a way to modify the code. I explored whether it would make sense to build a progress bar (or make use of the status bar) to inform the user of the macro progress, but as I understand it, the addition of this functionality, will further slow down the code.

Any help anyone can offer would be MUCH appreciated - thank you!

Sub DeleteMsProjectTask()
    DeleteTasks ActiveProject
    Dim sp As Subproject
    For Each sp In ActiveProject.Subprojects
        DeleteTasks sp.SourceProject
    Next sp
    MsgBox ("Done")
End Sub
Sub DeleteTasks(prj As Project)
Application.ScreenUpdating = False
    Dim NumTasks As Integer
    NumTasks = prj.Tasks.Count
    Dim t As Task
    Dim mileTsk As String
    Do While NumTasks > 0
        Set t = prj.Tasks(NumTasks)
        If t.OutlineLevel > 1 And t.Work = 0 Then
            mileTsk = t.GetField(FieldNameToFieldConstant("Key Milestone?", pjTask))
            If mileTsk = "No" Then
                t.Delete
            End If
        End If
        NumTasks = NumTasks - 1
    Loop
Application.ScreenUpdating = True
End Sub