3
\$\begingroup\$

The following code removes all pictures that are placed into Column A. When running the code however I have noticed it runs fairly slow. This will be attached to a command button that will be located in A1, it is important that the deleting of pictures doesnt target this command button. Any suggestions?

    ' Clears All Pictures
    Sub DeleteAllPics()
    Columns("A:A").Replace What:="No Picture Found", Replacement:="", LookAt:=xlPart
    Dim pic As Object
    For Each pic In ActiveSheet.Pictures
    pic.Delete
    Next pic
    End Sub
\$\endgroup\$
  • 4
    \$\begingroup\$ I don't really see an opportunity to optimize this, but I do see a couple of things that could be done a bit better. How many pictures are you deleting on average? \$\endgroup\$ – RubberDuck Jun 4 '15 at 20:12
4
\$\begingroup\$

I forced @proxy156 to start a new question which we discussed here Finding and pasting images into a specific cell

I just can't figure out how the formatting works in comments here. The problem here is that it takes a minute to delete about ~3000 pictures Also there was a problem with different shape objects that should not be deleted (Buttons)

This code should work a bit better

Sub DeleteAllPics()

    Dim wks         As Worksheet
    Dim shp         As Shape
    Dim picArray()  As String
    Dim index       As Integer

    On Error GoTo ErrorHandler

    Set wks = ActiveSheet
    index = 1
    For Each shp In wks.Shapes
        If shp.Type <> msoFormControl Then
            ReDim Preserve picArray(1 To index)
            picArray(index) = shp.Name
            index = index + 1
        End If
    Next shp

    wks.Shapes.Range(picArray).Delete


ExitRoutine:
    Set wks = Nothing
    Set shp = Nothing
    Erase picArray
    Exit Sub

ErrorHandler:
    MsgBox Prompt:="Unable to find photo", _
           Title:="An error occured", _
           Buttons:=vbExclamation
    Resume ExitRoutine

End Sub
\$\endgroup\$
  • \$\begingroup\$ That did fix the buttons deleting problem, but it still needs to be able to remove or replace the "No Picture Found" text that the other code adds when an image isn't found. What would you recommend? I really like the way your code is clean and clear. I'm trying to grasp what I can but I am still very new to the world of VBA. Thank you for helping me with these codes. \$\endgroup\$ – proxy156 Jun 4 '15 at 21:50
  • 1
    \$\begingroup\$ Ah sorry I missed it. I think you can happily use your existing code Columns("A:A").Replace What:="No Picture Found", Replacement:="", LookAt:=xlPart I'd just slightly change it to 'Columns(1).Replace What:="No Picture Found", Replacement:=vbNullString, LookAt:=xlPart` and for the What argument use the constant we did in your previous question. (assuming you have this code in the same module) \$\endgroup\$ – PetLahev Jun 4 '15 at 21:54
  • \$\begingroup\$ That did the trick. Thanks again for your help. P.S. I dont know if you only review, but if you also help create, I could use some input on my question here: [stackoverflow.com/questions/30601736/…, if not no worries :) \$\endgroup\$ – proxy156 Jun 4 '15 at 22:06
3
\$\begingroup\$
  • Everything inside of Sub...End Sub should be indented one level.
  • You're implicitly working on ActiveSheet.Columns when you call Columns.Replace. Normally, it's bad to act on the active worksheet, but this is one of the rare cases where it's appropriate. However, you should be explicit about it. Don't rely on the dev's knowledge that ActiveSheet.Columns is the same as Columns.
  • Everything inside of a For loop should be indented one level as well.
  • I like that you're explicit about the Next statement. Kind of... It's a great syntax to use if you have nested loops, but creates unnecessary maintenance in such a simple scenario. Now you have to rename the variable in three places if you decide to change it's name instead of just two.

    Sub DeleteAllPics() 'Clears All Pictures
         ActiveSheet.Columns("A:A").Replace What:="No Picture Found", Replacement:="", LookAt:=xlPart
        Dim pic As Object
        For Each pic In ActiveSheet.Pictures
            pic.Delete
        Next 
    End Sub
    

I really don't see an opportunity to optimize this, but maybe someone else will.

\$\endgroup\$
1
\$\begingroup\$

have you tried this:

Public Sub DeleteAllPics()

    Columns(1).Replace What:="No Picture Found", Replacement:=vbNullString, LookAt:=xlPart

    ActiveSheet.Pictures.Delete

End Sub

If the Pictures collection is distinct from the Shapes, it will only delete the actual uploaded images, without the buttons, an the Delete command on the collection itself deletes them all instantly without the loop - it did it for me with just a few, but it must be a lot faster with hundreds or more

(I tend to favor the KISS principle)

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.