speeding up object property changes

I'm currently using a loop that looks at each individual object in a document, checks its width and color and then either deletes it or moves it to a new layer. Some documents contain 20,000 objects. Using this type of loop is very slow. Does anyone have an ideas on how i could speed it up. The code i'm using is shown below. Many Thanks

For Each t In ActivePage.Shapes
ProgressBar1.Value = counter
counter = counter + 1
t.Outline.Color.ConvertToCMYK
If t.Outline.Width < 0.003 Then
t.Delete
ElseIf t.Outline.Color.CMYKBlack <> 100 Then
t.Outline.Width = 0.003
t.Layer = lyr
ElseIf t.Outline.Color.CMYKBlack = 100 Then
t.Outline.Width = 0.003
End If
Next

Read in Help about Optimization command, or seek for messages with this word in forum.

Now about your macro:

For Each t In ActivePage.Shapes
            ProgressBar1.Value = counter
            counter = counter + 1
            If t.Outline.Width < 0.003 Then t.Delete
'Delete objects before converting them to CMYK, you can save 19999 conversions in your 20000 objects :)
           t.Outline.Width = 0.003
'You are setting width = 0.003 to all undeleted objects, why not to make it here           
           t.Outline.Color.ConvertToCMYK      
           If t.Outline.Color.CMYKBlack <> 100 Then  t.Layer = lyr
        Next

HTH, Lev

[Alex]

I believe that the following code will run even faster:

Dim srDelete As New ShapeRange
Dim srMove As New ShapeRange
Dim t As Shape
Dim c As Color

For Each t In ActivePage.Shapes
    ProgressBar1.Value = counter
    counter = counter + 1
    If t.Outline.Width < 0.003 Then
        srDelete.Add t
    Else
        t.Outline.Width = 0.003
        Set c = t.Outline.Color
        c.ConvertToCMYK
        If c.CMYKBlack <> 100 Then srMove.Add t
    End If
    
    srDelete.Delete
    srMove.CreateSelection
    ActiveSelection.Layer = lyr
Next t

The idea is that instead of changing each individual shape, you instead just store them in a shape range and then after all processing is done, just delete and move all the shape in one shot.

You can also update outlines in similar way if you just need to convert the outline color model just to see if it is black.