Select All Shapes Except...

[Brorenzo]

Hi All,

I'm in need a of a bit of assistance. I have created a map of my company's regions that I want to use in a larger workbook. To put it simply, if a certain cell changes (it's currently a drop down), I want to change the color of that region to green, and the rest to black, essentially highlighting the desired region. Highlighting the region is working for me, but making the rest black is not. Can someone take a look at this code and/or the attached workbook and tell me what I'm doing wrong? Thanks in advance!

Private Sub Worksheet_Change(ByVal Target As Range)    If Target(1, 1).Address = Range("Q2").Address Then
        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
        
    'Problem happens here
        Dim GrpShape As Shape
        For Each GrpShape In ActiveSheet.Shapes
            If GrpShape <> "Group_" & Region Then 'This line is broken
                With ActiveSheet.Shapes
                    .SelectAll
                    .ShapeStyle = msoLineStylePreset8
                End With
            End If
        Next GrpShape
        
    End If
End Sub

File in Google Drive: Marco Help Needed.xlsm - Google Drive

 

[Brorenzo]

For what it's worth, a version of this works in my home made Jeopardy! workbook. It's where I got the idea.

Private Sub Worksheet_Activate()    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Game Board" Then
            sh.Visible = xlSheetHidden
        End If
    Next sh
End Sub

 

[Brorenzo]

I nearly have an answer, but this is throwing another error: Select All shapes except certain ones

"Application-defines 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