Найти два максимальных элемента последовательности и два минимальных - VB

Option Explicit
 
Private Sub Command1_Click()
    Dim Arr, i As Integer, B
    Arr = Array(130, 10, 58, 61, 74, 523, 31, 42, 55, 44, 48, 88, 43, 12, 39, 22, 31, 99)
    
    B = Arr
    BubbleSort B
    
    Print B(0)
    Print B(1)
    Print "-----"
    Print B(UBound(B) - 1)
    Print B(UBound(B))
    
End Sub
 
 
Public Sub BubbleSort(List)
Dim last_swap As Long, min As Integer, max As Integer
Dim i As Long, j As Long, tmp As Long
    max = UBound(List): min = LBound(List)
    ' Repeat until we are done.
    Do While min < max
        ' Bubble up.
        last_swap = min - 1
        ' For i = min + 1 To max
        i = min + 1
        Do While i <= max
            ' Find a bubble.
            If List(i - 1) > List(i) Then
                ' See where to drop the bubble.
                tmp = List(i - 1)
                j = i
                Do
                    List(j - 1) = List(j)
                    j = j + 1
                    If j > max Then Exit Do
                Loop While List(j) < tmp
                List(j - 1) = tmp
                last_swap = j - 1
                i = j + 1
            Else
                i = i + 1
            End If
        Loop
        ' Update max.
        max = last_swap - 1
        
        ' Bubble down.
        last_swap = max + 1
        ' For i = max - 1 To min Step -1
        i = max - 1
        Do While i >= min
            ' Find a bubble.
            If List(i + 1) < List(i) Then
                ' See where to drop the bubble.
                tmp = List(i + 1)
                j = i
                Do
                    List(j + 1) = List(j)
                    j = j - 1
                    If j < min Then Exit Do
                Loop While List(j) > tmp
                List(j + 1) = tmp
                last_swap = j + 1
                i = j - 1
            Else
                i = i - 1
            End If
        Loop
        ' Update min.
        min = last_swap + 1
    Loop
End Sub