Сортировка групп строк Excel VBA Macro

У меня возникли проблемы с выяснением того, как создать алгоритм сортировки в VBA, который сортирует и меняет местами группы строк (несколько строк за раз). Я написал успешный алгоритм сортировки, используя массив ниже:

Function SortArray(ByRef arrToSort As Variant)
Dim aLoop As Long, aLoop2 As Long
Dim str1 As String
Dim str2 As String
For aLoop = 1 To UBound(arrToSort)
   For aLoop2 = aLoop To UBound(arrToSort)
        If UCase(arrToSort(aLoop2)) < UCase(arrToSort(aLoop)) Then
            str1 = arrToSort(aLoop)
            str2 = arrToSort(aLoop2)
            arrToSort(aLoop) = str2
            arrToSort(aLoop2) = str1
        End If
    Next aLoop2
Next aLoop
SortArray = arrToSort

(где каждый элемент является элементом массива), но теперь я хочу отсортировать, заменив строки или группы строк. Я объясню, что я имею в виду ниже.

У меня есть рабочий лист с заголовками вверху и строками данных внизу:

Я хочу написать команду, которая работает по алгоритму выше. ОДНАКО, вместо замены элементов массива я хочу поменять местами целые группы строк. Заголовок3 ((может быть любой строкой) определяет группировку. Все группы на листе сортируются индивидуально и группируются.

Чтобы поменять местами сгруппированные строки, я написал следующую подпрограмму RowSwapper(), которая принимает две строки, содержащие строки для замены. (например, в форме rws1 = "3:5").

Public Sub RowSwapper(ByVal rws1 As String, ByVal rws2 As String)
'ACCOMODATE VARIABLE ROW LENGTHS!!!!
    ActiveSheet.Rows(rws1).Cut
    ActiveSheet.Rows(rws2).Insert Shift:=xlDown
    ActiveSheet.Rows(rws2).Cut
    ActiveSheet.Rows(rws1).Insert Shift:=xlDown
    MsgBox "RowSwapper: row" & rws1 & "swapped with row " & rws2
End Sub

Есть идеи? Моя стратегия, включая код, указана ниже:

МОЯ СТРАТЕГИЯ: у меня есть массивы prLst и srtdPrLst. prLst — это массив приоритетов сортировки. Позиция приоритета в prLst — это столбец (заголовок), на который он ссылается. srtdPrLst — это массив, содержащий приоритеты, отсортированные в порядке возрастания (например, 1,2,3....)

Я перебираю srtdPrLst, вызывая функцию FindPosition, чтобы найти положение каждого приоритета. Я зацикливаюсь назад, чтобы отсортировать в правильном порядке.

Затем для сортировки групп строк я использую ту же технику, что и код SortArray выше. Однако мне нужно собрать строки, в которых существует группа. Для этого у меня есть два цикла Do While, вложенных в циклы for, по одному для каждой группы (поскольку я сравниваю две группы в). Эти строки хранятся в переменных grpCnt1 (для первой сравниваемой группы) и grpCnt1 (для второй сравниваемой группы).

Поскольку отдельные группы уже отсортированы, мне нужно сравнить только первую строку каждой группы. Я сравниваю строки grp1Val с grp2Val с помощью простого оператора If. Если строки не в алфавитном порядке, я вызываю rowSwapper (перечисленный выше), чтобы поменять их местами.

Код описан ниже:

lstRowVal = Int(ActiveSheet.Range("AB" & totCount).Value) 'Индекс в массиве prLst — это столбец, которому присвоен приоритет, поэтому pos = номер столбца 'Сортирует в обратном порядке, чтобы получить приоритеты в соответствующий порядок 'MsgBox "marker = " & marker

For prior2 = Int(UBound(srtdPrLst)) To 1 Step -1
    MsgBox "prior2 = " & prior2
    If Int(srtdPrLst(prior2)) > 0 Then
        pos = FindPosition(Int(srtdPrLst(prior2)), prLst)

        'Algorithm to sort groups
        For lLoop = 2 To lstRowVal '2 b/c Starts at row below headers


            'Find first group to compare
            grp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop).Value
            hdToGrp1Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop).Value

            Do
                'nextGrp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & (lLoop + grpCnt1)).Value
                nxtHdToGrp1 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop + grpCnt1)).Value
                grpCnt1 = grpCnt1 + 1
            Loop While nxtHdToGrp1 = hdToGrp1Val


           For lLoop2 = lLoop To lstRowVal 

                'Find second group to compare
                grp2Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop2).Value
                hdToGrp2Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop2).Value

                Do
                    nxtHdToGrp2 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop2 + grpCnt2)).Value
                    grpCnt2 = grpCnt2 + 1
                Loop While nxtHdToGrp2 = hdToGrp2Val

                If UCase(grp2Val) < UCase(grp1Val) Then
                    RowSwapper lLoop & ":" & (lLoop + grpCnt1), lLoop2 & ":" & (lLoop2 + grpCnt2) 
                End If

                grp2Val = ""
                lLoop2 = lLoop2 + grpCnt2
                grpCnt2 = 0

            Next lLoop2


            grp1Val = ""
            lLoop = lLoop + grpCnt1
            grpCnt1 = 0

        Next lLoop
    End If
Next prior2