Сортиране на групи от редове 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

(където всеки елемент е елемент от масив), но сега искам да сортирам чрез размяна на редове или групи от редове. Ще обясня какво имам предвид по-долу.

Имам работен лист със заглавки в горната част и редове с данни отдолу:

Искам да напиша команда, която работи като горния алгоритъм. ОБАЧЕ, вместо да разменям елементи от масив, искам да разменям цели групи от редове. Header3 ((Може да бъде произволен низ) определя групирането. Всички групи в работния лист са сортирани индивидуално и групиране.

За да направя размяна на групирани редове, написах следния под 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 = " & маркер

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