Could I get some help with this DetectIntersects macro?

I need to be able to detect whether any shape selected intersects with any other shape in the selection. Regardless of whether the shape is a curve or text. Comes in handy just before cutting vinyl. Often times characters "overlap" each other so a warning needs to be thrown. In the image I have purposely moved an "f", within the artistic text, to intersect with another character. The macro errors at the line noted. Interesting to note is that sometimes when the text is converted to curves it becomes a group of shapes. Especially if a lot of text.

Sub DetectIntersects()
Dim sr As ShapeRange
Dim s1 As Shape, s2 As Shape
Dim bFound As Boolean
Optimization = True
bFound = False

Set sr = ActiveSelectionRange

If sr.Count <> 1 Then MsgBox ("Select shapes first"): GoTo exit1

For Each s1 In sr.Shapes
If bFound Then Exit For
For Each s2 In sr.Shapes
If Not s1 Is s2 Then
If s1.DisplayCurve.IntersectsWith(s2.DisplayCurve) Then 'ERROR HERE
bFound = True

Exit For
End If
End If
Next s2
Next s1


If bFound Then MsgBox "CAUTION! Something Intersects!!!", _
vbCritical, "Check For Intersecting lines"

If Not bFound Then MsgBox "Good", _
vbDefaultButton1, "Check For Intersecting lines"
Optimization = False
ActiveWindow.Refresh

exit1:

End Sub