Excel InputBox: group shapes and name groups with unique names

This code allows the user to group shapes in a selected range and name the group with a unique name.

It uses 2 InputBoxes:

"1/2 Select Shape Range"
"2/2 Enter Group Name"

Bug: If the user selects a range that is already grouped, the code stops working. Error: "Run-time error '438': Object doesn't support this property or method."

How do you insert a MsgBox at the beginning saying: "The selected shapes are already grouped. Please change your selection." and make the code only run, if the selection is "valid"?

Option Explicit
'===============================================================================
' InputBox: Group Shapes and Name Group v4.0
'===============================================================================
Sub IPB_Group_Shapes_v4_0()
Dim ws As Worksheet
Dim shp As Shape
Dim rng As Range
Dim grp As Object
Set ws = ActiveSheet
'Application.ScreenUpdating = False
  On Error Resume Next
    Set rng = Application.InputBox(Title:="1/2 Select Shape Range", _
                                   Prompt:="", _
                                   Type:=8)
  On Error GoTo 0
  If Not rng Is Nothing Then
    'Hide any Shape Outside Selected Range
      For Each shp In ws.Shapes
        If Intersect(rng, shp.TopLeftCell) Is Nothing And _
          Intersect(rng, shp.BottomRightCell) Is Nothing Then
             If shp.Type <> msoComment Then shp.Visible = msoFalse
        End If
      Next shp
    'Select All Visible Shapes
      On Error GoTo Skip
        ws.Shapes.SelectAll
      On Error GoTo 0
    'Group Shapes and Name Group with unique name
      If VarType(Selection) = 9 Then
        Set grp = Selection.Group        
        With grp
            Dim gName As String
            gName = Application.InputBox(Title:="2/2 Enter Group Name", _
                                         Default:="ClickGroup [00 Name] ", _
                                         Prompt:="", _
                                         Type:=2)
            If Not ValidateName(gName) Then
               MsgBox "Group name [" & gName & "] is duplicated." _
               & vbCrLf & "Try again.", vbExclamation, "Duplicate"
               gName = Application.InputBox(Title:="2/2 Enter Group Name", _
                                            Default:="ClickGroup [00 Name] ", _
                                            Prompt:="", _
                                            Type:=2)
            End If
            If ValidateName(gName) Then
                grp.Name = gName
            Else
                MsgBox "Group name [" & gName & "] is already taken." _
                & vbCrLf & "Please restart.", vbExclamation, "Restart"
                grp.Select
            End If
        End With
    MsgBox "Group Name:" & vbNewLine & vbNewLine & _
                 "" & grp.Name, , ""  
        grp.Select
      End If
Skip:
    'Unhide rest of the Shapes
      For Each shp In ws.Shapes
        If shp.Type <> msoComment Then
          If shp.Visible = msoFalse Then shp.Visible = msoTrue
        End If
      Next shp
  End If
End Sub
'===============================================================================

Idea:

If Selection Is grp Then
MsgBox "These Shapes are already grouped.", vbExclamation, "Please retry."
Else
End If

Solution

ActiveSheet.Shapes.Range(..).Select select the desired shapes
The If to determine whether the shape cross with selected range is not reliable. eg. shape's TopRightCell may be in the selected range. Change the code to :

If Not Intersect(rng, Range(shp.TopLeftCell, shp.BottomRightCell)) Is Nothing Then

Option Explicit
'===============================================================================
' InputBox: Group Shapes and Name Group v4.0
'===============================================================================
Sub IPB_Group_Shapes_v4_0()
Dim ws As Worksheet
Dim shp As Shape
Dim rng As Range
Dim grp As Object
Dim aShp(), iR As Long
Set ws = ActiveSheet
'Application.ScreenUpdating = False
  On Error Resume Next
    Set rng = Application.InputBox(Title:="1/2 Select Shape Range", _
                                   Prompt:="", _
                                   Type:=8)
  On Error GoTo 0
  If Not rng Is Nothing Then
    ReDim aShp(1 To ws.Shapes.Count)
    'Hide any Shape Outside Selected Range
      For Each shp In ws.Shapes
        If Not Intersect(rng, Range(shp.TopLeftCell, shp.BottomRightCell)) Is Nothing Then
            If shp.Type <> msoComment Then
                iR = iR + 1
                aShp(iR) = shp.Name
            End If
        End If
      Next shp
      If iR = 0 Then Exit Sub ' no shape in selected range
      ReDim Preserve aShp(1 To iR)
    'Group Shapes and Name Group with unique name
      If iR > 1 Then ' more than one shapes
        ' ***
        ActiveSheet.Shapes.Range(aShp).Select ' select shapes
        Set grp = Selection.ShapeRange.Group  ' group shapes
        ' ***
        With grp
            Dim gName As String
            gName = Application.InputBox(Title:="2/2 Enter Group Name", _
                                         Default:="ClickGroup [00 Name] ", _
                                         Prompt:="", _
                                         Type:=2)
            If Not ValidateName(gName) Then
               MsgBox "Group name [" & gName & "] is duplicated." _
               & vbCrLf & "Try again.", vbExclamation, "Duplicate"
               gName = Application.InputBox(Title:="2/2 Enter Group Name", _
                                            Default:="ClickGroup [00 Name] ", _
                                            Prompt:="", _
                                            Type:=2)
            End If
            If ValidateName(gName) Then
                grp.Name = gName
            Else
                MsgBox "Group name [" & gName & "] is already taken." _
                & vbCrLf & "Please restart.", vbExclamation, "Restart"
                grp.Select
            End If
        End With
    MsgBox "Group Name:" & vbNewLine & vbNewLine & _
                 "" & grp.Name, , ""
        grp.Select
      End If
Skip:
    'Unhide rest of the Shapes
    ' pass
  End If
End Sub
Function ValidateName(ByVal ShpName As String) As Boolean
    Dim s As Shape
    On Error Resume Next
    Set s = ActiveSheet.Shapes(ShpName)
    On Error GoTo 0
    ValidateName = (s Is Nothing)
End Function