How to check if objects intersect or if one object is inside another? (VBA)

Hello!

Imagine the situation.

I drew 20 rectangles. I accidentally copied one rectangle and pasted it in the same place. Since the coordinates of the main rectangle and the copied one are the same, if you look closely, I will see only a slight thickening of the outline, which is almost imperceptible at a quick glance.

And here is the task that I want to implement. I need to ensure that there are no doubles of rectangles and that they do not overlap

The user selects all the rectangles, runs a macro that checks if the rectangles intersect, or if one is on top of the other, and if this situation is detected, one of the two found rectangles is highlighted in red and shifts upwards, for example, 5 centimeters.

I implemented this

---### VBA CODE ###---

'Variables

Dim srcheck As ShapeRange                    'Active Selection
Dim scheck1 As Shape                             ' First rectangle
Dim scheck2 As Shape                             'Second rectangle
Dim i As Integer                                         'Counter
Dim j As Integer                                         'Counter
Dim n As Integer                                        'Counter

n = 1                                                         'Set value of n as 1
Set srcheck = ActiveSelectionRange      'Set active selection

'Since we need to select two different rectangles, i will be for one rectangle, j for another

For i = n To srcheck.Shapes.count        'Count from the start rectangle in the selection to the end
 
     For j = n To srcheck.Shapes.count              'Count from the start rectangle in the selection to the end

          If i <> j Then          'If it turns out that the two compared objects are the same rectangle, then go to the next pair

               Set scheck1 = srcheck(i)
               Set scheck2 = srcheck(j)
               scheck1.ConvertToCurves
               scheck2.ConvertToCurves

               If scheck1.Curve.IntersectsWith(scheck2.Curve) = True Then    'If we get intersection then...
                    srcheck(i).Fill.UniformColor.RGBAssign 255, 0, 0                 'fill red and 
                    srcheck(i).Move 2, 2                                                                 'move
               End If

          End If
     Next j
n = n + 1 ' Add one. Now, new cycles will begin already with a deuce, thereby we will not re-check the pairs of rectangles that we have already checked. If this is not done, then checking the first and second rectangle, the next time the second and first will be checked (which is the same)
Next i

As a result, it all works, although I have only done the intersection check so far, the problem is that the same 20 rectangles will be checked sooooo long (190 checks, and can take up to several minutes in time) What can I say when projects can occur from 100 to 10,000 rectangles.

Is it possible, for example, to select a rectangle, somehow understand which rectangles lie closest to it, and already check between them, and not with the entire set of rectangles?