Option Explicit
'====================================================================================================
Sub GetMin()
Dim arr, arr1x(), r&, i&
Const crit$ = "Олег"

arr = Selection.Value2
If Not IsArray(arr) Then Exit Sub
If UBound(arr, 1) < 2 Then Exit Sub
If UBound(arr, 2) <> 2 Then Exit Sub
ReDim arr1x(UBound(arr, 1) - 1): i = -1

    For r = 1 To UBound(arr, 1)
        If arr(r, 1) = crit Then
            i = i + 1: arr1x(i) = arr(r, 2)
        End If
    Next r
If i < 1 Then Exit Sub

ReDim Preserve arr1x(i)
Sort_Array1x arr1x, 0, i

MsgBox CDate(arr1x(0)) & " | " & CDate(arr1x(1))
End Sub
'====================================================================================================
Sub Sort_Array1x(arr1x(), l&, u&)
Dim i&, j&, x, y

i = l: j = u: x = arr1x((l + u) \ 2)

        Do
            Do While arr1x(i) < x: i = i + 1: Loop
            Do While x < arr1x(j): j = j - 1: Loop
            If i <= j Then y = arr1x(i): arr1x(i) = arr1x(j): arr1x(j) = y: i = i + 1: j = j - 1
        Loop Until i > j

If l < j Then Sort_Array1x arr1x, l, j
If i < u Then Sort_Array1x arr1x, i, u
End Sub
'====================================================================================================