Select all unwanted shapes in range

[ceecee88]

Hi, I'm trying to select all the unwanted shapes in the range and I'm almost there but get stuck on one issue.
Example below, I'm trying to select all shapes that are aren't named Rectangle 1 and Rectangle 5 in range A1:O30 and it should select 3 shapes which are Rectangle 12 and Rectangle x 2. The problem with my code is that it won't select if the name is duplicate. Now, it is only select Rectangle 12 as Rectangle has 2 shapes with the same name. How do I adjust it to select all unwanted shapes even if it has duplicate name.

Here is my code, any suggestion will be much appreciated.
Thank you

Sub SelectunwatedShape()
Dim shp As Shape, r As Range, s As Range, myarr(), n As Integer
ReDim myarr(ActiveSheet.Shapes.Count)

Set r = Range("A1:O30")
ActiveCell.Select
  
   For Each shp In ActiveSheet.Shapes
    If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then
    If shp.Name <> "Rectangle 1" And shp.Name <> "Rectangle 5" Then
         myarr(n) = shp.Name
         n = n + 1
        End If
        End If
Next shp

On Error Resume Next
ReDim Preserve myarr(n - 1)
    ActiveSheet.Shapes.Range(myarr).Select
End Sub

 

[JoeMo]

Just curious, how did you manage to have two rectangles with the same name on the same sheet?

 

[ceecee88]

Just curious, how did you manage to have two rectangles with the same name on the same sheet?

Hi, I just copy and paste.

 

[Herakles]

Not a conclusive test but it only seems to work for me with a rectangle called Rectangle.

 

[JoeMo]

Try this:

Sub SelectunwatedShape()
Dim R As Range, shp As Shape
Set R = Range("A1:O30")
For Each shp In ActiveSheet.Shapes
    If Not Intersect(R, Range(shp.TopLeftCell, shp.BottomRightCell)) Is Nothing Then
        If shp.Name <> "Rectangle 1" And shp.Name <> "Rectangle 5" Then
            shp.Select Replace:=False
        End If
    End If
Next shp
End Sub

 

[ceecee88]

Not a conclusive test but it only seems to work for me with a rectangle called Rectangle.

Hi, I'm not really sure what do you mean?

 

[JoeMo]

Hi, I'm not really sure what do you mean?

Did you try the code in post #5?

 

[Herakles]

Hi, I'm not really sure what do you mean?

I was referring to the copy and paste of shapes.

If I copy and paste a rectangle shape named 'Rectangle' it creates a copy with the same name.

If I copy and paste a rectangle shape named 'Rectangle 1' it creates a copy but gives it a new suffix number depending on how many shapes there are already on the sheet.

 

[ceecee88]

Did you try the code in post #5?

Hi, sorry for the delay getting back to you. I tried it just now, it work perfectly, thank you so much!

 

[JoeMo]

Hi, sorry for the delay getting back to you. I tried it just now, it work perfectly, thank you so much!

You are welcome - thanks for the reply.