With ActiveSheet
            .Shapes.Range(Array(.Shapes.Count, .Shapes.Count - 1, .Shapes.Count - 2)).Group
        End With

Private Const secondsWait = 5

Private s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape, s5 As Shape, c As New Collection ': Const secondsWait = 5

Private Sub CreateArrow()
    If s1 Is Nothing Then
       Set s1 = ActiveSheet.Shapes(Application.Caller)
    Else
        Set s2 = ActiveSheet.Shapes(Application.Caller)
        x1! = s1.Left + s1.Width / 2: y1! = s1.Top + s1.Height / 2
        x2! = s2.Left + s2.Width / 2: y2! = s2.Top + s2.Height / 2
        Set s3 = ActiveSheet.Shapes.AddLine(x1!, y1!, x2!, y2!)
        With s3.Line
            .EndArrowheadStyle = msoArrowheadTriangle
            .Weight = 2
            .ForeColor.RGB = vbRed
        End With
        Set s4 = ActiveSheet.Shapes.AddLine(x1 - (y2 - y1) / 4, y1 + (x2 - x1) / 4, x1 + (y2 - y1) / 4, y1 - (x2 - x1) / 4)
        Set s5 = ActiveSheet.Shapes.AddLine(x2 - (y2 - y1) / 4, y2 + (x2 - x1) / 4, x2 + (y2 - y1) / 4, y2 - (x2 - x1) / 4)
        ActiveSheet.Shapes.Range(Array(s3.Name, s4.Name, s5.Name)).Group
        c.Add s3: Set s1 = Nothing ': Set s2 = Nothing
    End If
End Sub