Select All shapes except certain ones

[bvokey]

Hello,

I have a VBA code that varies which objects are on the sheet or not based on the code. All I want to do is a method of Selecting all shapes on the sheet, except a certain few (these will be specific named objects). Is there an easy method of doing this?

Thanks in advance

 

[Domenic]

Assuming that the sheet containing the shapes is the active sheet, try...

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] test()

    [COLOR=darkblue]Dim[/COLOR] vShapesToExclude [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] aShapesToSelect() [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] oShape [COLOR=darkblue]As[/COLOR] Shape
    [COLOR=darkblue]Dim[/COLOR] vMatchVal [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] ShpCnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    vShapesToExclude = Array("Rectangle 1", "Oval 1") [COLOR=green]'change and add the names of shapes to exclude[/COLOR]
    
    [COLOR=darkblue]ReDim[/COLOR] aShapesToSelect(1 To ActiveSheet.Shapes.Count)
    
    ShpCnt = 0
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] oShape [COLOR=darkblue]In[/COLOR] ActiveSheet.Shapes
        vMatchVal = Application.Match(oShape.Name, vShapesToExclude, 0)
        [COLOR=darkblue]If[/COLOR] IsError(vMatchVal) [COLOR=darkblue]Then[/COLOR]
            ShpCnt = ShpCnt + 1
            aShapesToSelect(ShpCnt) = oShape.Name
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] oShape
    
    [COLOR=darkblue]ReDim[/COLOR] [COLOR=darkblue]Preserve[/COLOR] aShapesToSelect(1 To ShpCnt)
    
    ActiveSheet.Shapes.Range(aShapesToSelect).Select
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!

 

[bvokey]

Worked great,

Thanks Domenic!

 

[Brorenzo]

Hi Domenic,

I'm trying to use your macro, but getting an error. Any thoughts?

"Application-defined or object-defined error"

Dim vShapesToExclude As Variant
Dim aShapesToSelect() As String
    Dim oShape As Shape
    Dim vMatchVal As Variant
    Dim ShpCnt As Long
    
    vShapesToExclude = Array(Region, "RegionMap", "RegionNames")
    
    ReDim aShapesToSelect(1 To ActiveSheet.Shapes.Count)
    
    ShpCnt = 0
    For Each oShape In ActiveSheet.Shapes
        vMatchVal = Application.Match(oShape.Name, vShapesToExclude, 0)
        If IsError(vMatchVal) Then
            ShpCnt = ShpCnt + 1
            aShapesToSelect(ShpCnt) = oShape.Name
        End If
    Next oShape
        
    ReDim Preserve aShapesToSelect(1 To ShpCnt)
    ActiveSheet.Shapes.Range(aShapesToSelect).Select

 

[Domenic]

It looks like you've omitted the quotes around the name of your first shape...

vShapesToExclude = Array("Region", "RegionMap", "RegionNames")

 

[Brorenzo]

It looks like you've omitted the quotes around the name of your first shape...

vShapesToExclude = Array("Region", "RegionMap", "RegionNames")

That's actually not a shape name per say, it's a Dim. Here's the full macro:

Sub Test()
        Dim Region As Range
        Set Region = Range("Q2")
        
        If Region = "International" Then
            Range("S2").Value = "Group_Southeast" 'This line can be deleted once the macro is figured out
            With ActiveSheet.Shapes.Range(Array("Group_Southeast"))
                .ZOrder msoBringToFront
                .ShapeStyle = msoLineStylePreset11
            End With
        Else
            Range("S2").Value = "Group_" & Region 'This line can be deleted once the macro is figured out
            With ActiveSheet.Shapes.Range(Array("Group_" & Region))
                .ZOrder msoBringToFront
                .ShapeStyle = msoLineStylePreset11
            End With
        End If








    Dim vShapesToExclude As Variant
    Dim aShapesToSelect() As String
    Dim oShape As Shape
    Dim vMatchVal As Variant
    Dim ShpCnt As Long
    
    vShapesToExclude = Array(Region, "RegionMap", "RegionNames")
    
    ReDim aShapesToSelect(1 To ActiveSheet.Shapes.Count)
    
    ShpCnt = 0
    For Each oShape In ActiveSheet.Shapes
        vMatchVal = Application.Match(oShape.Name, vShapesToExclude, 0)
        If IsError(vMatchVal) Then
            ShpCnt = ShpCnt + 1
            aShapesToSelect(ShpCnt) = oShape.Name
        End If
    Next oShape
        
    ReDim Preserve aShapesToSelect(1 To ShpCnt)
    ActiveSheet.Shapes.Range(aShapesToSelect).Select
End Sub

 

[Domenic]

What type of error are you getting?

 

[Brorenzo]

I put a screenshot in my other post, but it's an "Application-defined or object-defined error" on ActiveSheet.Shapes.Range(aShapesToSelect).Select.

 

[Domenic]

Sorry, I missed it. One reason for the error could be that aShapesToSelect is empty. But if that's the case, you would get an error prior to that line. Try stepping through the code to see if at least one name gets transferred to the array. Also, you could check to see if the value of ShpCnt is at least 1.

 

[Brorenzo]

Figured it out.

Had to change this:

To this:

Note the addition of "()".