A massive USA map with over 2,600 county shapes is available for download in the blog post "Choropleth Map Template USA by Counties" by Robert Mundigl. The Selection Pane (Ribbon: Page Layout) reveals that the shapes are NOT grouped. 

When working with map shapes, please take into account that some shapes may have to be excluded from hyperlink assignment etc e.g. separator lines (S_Separator) etc.

It is evident that any interactive drill-down action on county level is quite difficult at this zoom level. It would be ideal, if the user could drill-down county information by using a zoomed version of the state clicked within the main USA map.

Steps needed to achieve this feature:
​

• Group all state counties using the demo array VBA version provided. The selection approach is included for demonstrating slow performance, when VBA code hits the Excel grid multiple times. 
  
  
• Copy the new group to clipboard.
  
  
• Insert a new worksheet.
  
  
• Paste the grouped state shape and zoom to 200-250%.
  
  
• The state shape can be ungrouped and hyperlinks could be assigned as explained in previous articles.
  
  
• Return to the main USA map sheet, ungroup the state you are working with and assign the same hyperlink to all counties, so that the user can navigate to the state sheets by clicking any county in the state. 
  
  
• If screentips are not required in the main USA map, an OnAction macro could be assigned to grouped states, instead of assigning hyperlinks to individual counties.

Sub GroupShapesWithArray()
 
    Dim oShp As Shape
    Dim oState As Shape
    Dim oWS As Worksheet
    Dim strState As String
    Dim x As Variant
    Dim t As Double
     
    t = Time()
     
    Set oWS = ThisWorkbook.Sheets("US County Map")
     
    oWS.Range("A1").Select
     
    For Each oShp In oWS.Shapes
     
        If InStr(oShp.Name, "_CA") > 0 Then
            strState = strState & "," & oShp.Name
        End If
     
    Next oShp
     
    strState = Right(strState, Len(strState) - 1)
     
    x = Split(strState, ",")
     
    Set oState = oWS.Shapes.Range((x)).Group
     
    With oState
        .Name = "California"
        .Select
    End With
 
    Debug.Print t - Time()
 
End Sub
 
 
Sub GroupShapesWithSelection()  'Very slow !!!
     
    Dim oShp As Shape
    Dim oWS As Worksheet
    Dim t As Double
     
    t = Time()
     
    Set oWS = ThisWorkbook.Sheets("US County Map")
     
    oWS.Range("A1").Select
     
    For Each oShp In oWS.Shapes
     
        If InStr(oShp.Name, "_CA") > 0 Then
            oShp.Select False
        End If
     
    Next oShp
     
    Selection.ShapeRange.Group.Select
    Selection.Name = "California"
        
    Debug.Print t - Time()
 
End Sub 

Computing performance is significantly degraded, when working with over 5,000 shapes (main map & states sheets), so high-end hardware is recommended for such a complex project.

---

choropleth_map_us_counties_group.xlsb
File Size:	2757 kb
File Type:	xlsb

Download File

---