VBA traversering af rækker og gruppering (group/ungroup function)

Hej,
Håber virkelig på et lyst hoved der kan redde min fredag.
Hvilken algoritme er den rigtige til at traversere 26.000 rækker og få dem lagt i grupper med embedded groupings nedenunder, således at man får defineret og lukket grupperne via VBA?

Afsæt:
Jeg bruger Office 2010, excel, men enhver Excel fra 2003 vil kunne bruges.

Jeg ønsker anvendelse af VBA grouping functionen
Rows("17:18).Group

Jeg har fjernet flueben for "Summary row belows detail", således at grupperingen samles i linjen ovenover, dvs. eksekvering af 
Rows("17:18").Group 
Danner dermed en gruppe hvor "krydset" vises ud for række 16, og ved tryk herpå synliggøres 17 & 18 som nu er level 2.


Mit dilemma:
Data er allerede sorteret så det er fint, men jeg skal folde 26.000 rækker ind i 4 niveauer, hvor man kan have embedded groupings med igen embedded groupings, hvor grupper kan indeholde "1-til-mange underpunkter og undergrupper" men jeg kan ikke regne den rigtige algoritme ud.

I mit eksempel har jeg allerede sorteret nogle fiktive geografiske data for illustrationens skyld som i kolonne A beskriver hvilket niveau data er på og i kolonne B en konkret værdi. Jeg vil således gerne skrive en algoritme som traverserer A-kolonnen og holder styr på hvilke groupings der skal laves for de forskellige ROWS.


Kontinent indeholder 0-til-mange lande
Lande indeholder 0-til-mange byer
Byer indeholder 0-til-mange gader

Succeskriterie:
Når jeg trykker på "Level 1" vises kun Kontinenters rækker. Hvis et kontinent indeholder lande, vises et plus.
Når jeg trykker på "Level 2" vises kun Kontinenter og Lande. Hvis et land indeholder byer, vises et plus ud for landet.
Når jeg trykker på "Level 3" vises kun Kontinenter, Lande og Byer. Hvis en by indeholder gader, vises et plus ud for byen.
Når jeg trykker på "Level 4" vises alle data, dvs Kontinenter, Lande, Byer og gader. Der er ikke under-grupper til gader, så der er ikke PLUS ud for nogen gader.

A1: Kontinent, B1:Europa
A2: Land, B2:Danmark
A3: By, B3:Silkeborg
A4: Gade, B4:Vestergade
A5: Gade, B5:Søndergade
A6: By, B6:Århus
A7: Gade, B7:Marselisborg Boulevard
A8: Land, B8:Tyskland
A9: By, B9: Kiel
A10: Kontinent, B10:Asien
A11: Land, B11:Kina
A12: Land, B12:Thailand
A13: Land, B13:Sydkorea
A14: By, 14:Seoul

Ovenstående vil foldet helt sammen kun vise
KRYDS ud for Række 1
KRYDS ud for Række 10

Trykker jeg på "Level 2" vises Kontinenter og Lande (Række 1,2,8,10,11,12,13).
Der er PLUS ud for følgende landerækker (Række 2,8,13)

Og så videre.

Håber dette giver mening.

Min løsning som jeg er strandet med gik ud på at definere et VBA-array, hvor jeg holdt styr på, hvilket niveauer der er aktive - men jeg kan ikke rydde op ordentligt - når data pludselig springer til et nyt kontinent skal jeg pænt lukke "åbne" byer og lande, men dette kan jeg ikke gennemskue. Jeg vil lade være med at poste de forskellige missede oprydningsforsøg...



----------
Public sub GroupData

Dim levels(5, 3)
' number of item:(1=Kontinent, 2=Land, 3=By, 4=Gade
' 1. dimension is true from the line we first encounters this data level
' 2. dimension logs the first row number grouped into this level
' 3. dimension logs the running number grouped into this level as long as the same level of data is in rows after each other


Range("a1").Select

For j = 1 To 4
    levels(j, 1) = False ‘no data has been analyzed, so all levels are FALSE
Next

While clearCells < 100
    i = i + 1
    If Len(ActiveCell.Offset(i, 0)) < 1 Then
        clearCells = clearCells + 1
    Else
          ' something is written in this cell       
          Debug.Print "this row: i=" & i & " addr.: " & ActiveCell.Offset(i, 0).Address & " with value: " & ActiveCell.Offset(i, 0).Value
       
        thisCellLevel = returnLevel(ActiveCell.Offset(i, 0).Value)
        If levels(thisCellLevel, 1) = False Then
            ' I need to start this level
            levels(thisCellLevel, 1) = True
            levels(thisCellLevel, 2) = i
            levels(thisCellLevel, 3) = i
        Else
            'This level has already been opened.

            ‘ If it was opened directly above this line, then we are in a list of equal level items
                      If (levels(thisCellLevel, 2) = i - 1) Then 'this is a running list of same level, move cursor for indent to current line
                            levels(thisCellLevel, 3) = i

‘ if a higher value has been opened since this level was opened, then this is e.g. a new country, so I should close the old country and prepare this one
            ' I need to close the doors behind me in a structured way...  XXXX HERE ARE THE PROBLEMS
                  Else
                          Rows(levels(thisCellLevel, 2) + 2 & ":" & i).Group
                  endif
      endif
endif
Wend

End sub

------------
Function returnLevel(inputval As String) As Integer

Level_1 = "Kontinent"
Level_2 = "Land"
Level_3 = "By"
Level_4 = "Gade"

If inputval = Level_1 Then returnLevel = 1
If inputval = Level_2 Then returnLevel = 2
If inputval = Level_3 Then returnLevel = 3
If inputval = Level_4 Then returnLevel = 4
End Function