Deleting all pictures in a range except for specified ones and find/replace question

[Moonbeam111]

I'm trying to delete pictures in range J22:J25 except for the picture named "ZC_Pic". Here's the code I was using. It works but it deletes ZC_Pic.

Set xRg = Range("J22:J25")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next

If I change my code to this:

Dim xpic As Picture
Set xRg = Range("J22:J25")
For Each xpic In xRg
If xpic <> "ZC_Pic" Then
xpic.Delete
End If
Next xpic

I get a type mismatch error and/or application, object defined error here: For Each xpic In xRg . I don't quite understand why.


I have another question. Is there a quick and dirty way to insert a column and then use the find/replace in VBA to make every range reference one column further? For example, if my ranges were all in B and C and D. And I inserted a column, could I use a find/replace (possibly using pattern searching) to have each macro that was B,C,D now reference C,D,E?

 

[JoeMo]

Try:

Dim xPic As Picture
Set xRg = Range("J22:J25")
    For Each xPic In ActiveSheet.Pictures
        If xPic.Name <> "ZC_Pic" Then
            Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
            If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
        End If
    Next xPic

Your "other question" would be more appropriate for a separate thread.

 

[jolivanes]

If your top code works, using "Select Case" would be one of the many possible solutions.

I guess you don't need to. JoeMo has the perfect solution.

 

[Moonbeam111]

Thank you for the code I don't know why but it still gave me a type mismatch error pointing to the "next xpic" line however i was able to resolve it with a small modification:

Set xRg = Range("J22:J25")
  For Each xpic In ActiveSheet.Shapes
    If xpic.Name Like "Picture *" Then
      Set xPicRg = Range(xpic.TopLeftCell.Address & ":" & xpic.BottomRightCell.Address)
      If Not Intersect(xRg, xPicRg) Is Nothing Then xpic.Delete
    End If
  Next xpic

Your "other question" would be more appropriate for a separate thread.

Would this sub-forum be the appropriate place for the other question? It seems like it might be more of a regular expression question, rather than a vba/excel one.

 

[JoeMo]

Thank you for the code I don't know why but it still gave me a type mismatch error pointing to the "next xpic" line however i was able to resolve it with a small modification:

Set xRg = Range("J22:J25")
  For Each xpic In ActiveSheet.Shapes
    If xpic.Name Like "Picture *" Then
      Set xPicRg = Range(xpic.TopLeftCell.Address & ":" & xpic.BottomRightCell.Address)
      If Not Intersect(xRg, xPicRg) Is Nothing Then xpic.Delete
    End If
  Next xpic

Would this sub-forum be the appropriate place for the other question? It seems like it might be more of a regular expression question, rather than a vba/excel one.

Did you dim xPic as Picture as shown in Post #2? If not, that may be why you received a type mismatch error.

This forum would be the right place for your other question.