Size shapes to first object marked

Question

I struggle with a macro to make all shapes (rectangles in this case) the same size. Example: I have three rectangles in three different sizes. Now, I want to resize all rectangles to the same size using the first rectangle I have clicked/marked.

How to come around this problem?

There is a macro I have found sizing to the smallest shape range, but not if the "mid rectangle" should be the dominant one...

Sub ResizeToSmallest()
    ' PPT coordinates are Singles rather than Doubles
    Dim sngNewWidth As Single
    Dim sngNewHeight As Single
    Dim oSh As Shape

    ' Start with the height/width of first shape in selection
    With ActiveWindow.Selection.ShapeRange
        sngNewWidth = .Item(1).Width
        sngNewHeight = .Item(1).Height
    End With

    ' First find the smallest shape in the selection
    For Each oSh In ActiveWindow.Selection.ShapeRange
        If oSh.Width < sngNewWidth Then
            sngNewWidth = oSh.Width
        End If
        If oSh.Height < sngNewHeight Then
            sngNewHeight = oSh.Height
        End If
    Next

    ' now that we know the height/width of smallest shape
    For Each oSh In ActiveWindow.Selection.ShapeRange
        oSh.Width = sngNewWidth
        oSh.Height = sngNewHeight
    Next

End Sub