Использование функции сортировки по массиву динамических диапазонов в VBA?

Question

Иметь массив динамических диапазонов, которые должны быть отсортированы по позиции B1 в каждом. Я написал очень длинный неэффективный код для пузырьковой сортировки, который иногда ломался и интересовался, может ли функция .Sort работать. Вот код, который зацикливается в каждом динамическом диапазоне. Если есть синтаксические ошибки, это потому, что я вырезал его из большего кода. Я могу заверить вас, что все работает до строки .Sort:

Private Sub CommandButton1_Click()
Dim everything() As Range
Dim check As Range
Dim count As Range

Dim lr As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim q As Long
With ThisWorkbook.Sheets("Names and Vendors")

'Counts how many rows contain data
If .Cells(.Rows.count, "D").End(xlUp).Row > .Cells(.Rows.count, "B").End(xlUp).Row Then
    lr = .Cells(.Rows.count, "D").End(xlUp).Row
    Else
    lr = .Cells(.Rows.count, "B").End(xlUp).Row
    End If

'Step 1: Counts number of RMs to size the "everything" array

For z = 2 To lr
    Set count = .Range("B" & z)
        If IsEmpty(count) = False Then
            count.Select
            q = q + 1
            End If
    Next z
    ReDim everything(q - 1) As Range 'Resizes array

'Step 2: Loops all RM info into array by each distinct range

For x = 2 To lr
    Set check = .Range("A" & x & ":Q" & x)

        'ensures subcomponents are added to range
        If IsEmpty(.Range("B" & 1 + x)) = True Then
            Do While IsEmpty(.Range("B" & 1 + x)) = True And x < lr
                Set check = Union(check, .Range("A" & 1 + x & ":Q" & 1 + x))
                check.Select
                x = x + 1
            Loop
        End If
    Set everything(y) = check
    y = y + 1
    check.Select
Next x

'This doesn't work. Is there a way to make it work?
everything.Sort Key1:=Range("B1"), Order1:=xlAscending, MatchCase:=False

End With
End Sub