excel macro for grouping non continuous data

Question

First image is my data set Col A thru col AX, part of the macro drops equation into AY.

image 2 is my desired perfect result

col A is report level, col AY is the trimmed version of A. col B is item / doc row, L for Item, blank for doc. col c is item counter (increases by 10 with each new item, but maintains if doc), picks up from last item in that level. These are all of useful for what the end goal is. That goal is to drop the untouched report into a file, a button will run the macro which groups the rows according to report level and some formatting.

This report/ example has 4 layers, I'd like the code to run from bottom to top and group the level 4's it finds (rows 34:37), then keep scanning upwards until row 2. Restart the scan from the bottom again for level 3's (rows 31:44, 15:16). restart and find 2, then restart and find 1 . The levels that come out of the report could be as high as 25.

here's my code so far and it doesn't group properly so open to any suggestions.

    Sub FORMAT_SAP_ZPL_BOMEX_report_MK_01_01()
    '
    ' grouping_BOMEX_report Macro
    '
    ' ========== takes report from SAP tcode "ZPL_BOMEX" and
    ' ========== reorginazes the dataout put into something cleaner
    '

    'Application.ScreenUpdating = False

        With ActiveSheet.Outline
            .AutomaticStyles = False
            .SummaryRow = xlAbove
            .SummaryColumn = xlLeft
        End With

    ' \\\    get last row and column of data

    Dim lrow As String
    Dim nextblank As String

    ' \\\    last row
        lrow = Cells(Rows.Count, 1).End(xlUp).Row

        gmax = Application.WorksheetFunction.Max(Range("ay:ay"))

    For g = gmax To 0 Step -1

        For scanRow = lrow To 2 Step -1
        If Range("AY" & scanRow) = g Then
            Range("AZ" & scanRow) = 1
            End If
                Next scanRow


              EndRow = Cells(Cells.Rows.Count, "AZ").End(xlUp).Row
    jumpin1:
              StartRow = Range("AZ" & EndRow).End(xlUp).Row

                          Rows(StartRow & ":" & EndRow).Rows.Group
    '            Rows(StartRow & ":" & EndRow).Select
    '                Selection.Rows.Group


        nextblank = Range("AZ" & StartRow).End(xlUp).Row

           If nextblank > 2 Then
                EndRow = Range("AZ" & nextblank).Row
                    GoTo jumpin1

                Else
                    End If


        ActiveSheet.Columns(52).ClearContents


    Next g
end sub

Answer 1

my finished code that works. I don't know if there's a way to store multiple ranges at once, that would eliminate the need for at least one level of the loop I believe

Sub FORMAT_SAP_ZPL_BOMEX_report_MK_01_02()
'
' grouping_BOMEX_report Macro
'
' ========== takes report from SAP tcode "ZPL_BOMEX" and
' ========== reorginazes the dataout put into something cleaner
'

Application.DisplayAlerts = False
Application.ScreenUpdating = False

    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlLeft
    End With

' \\\    get last row and column of data

Dim lrow As String
Dim nextblank As String

' \\\    last row
    lrow = Cells(Rows.Count, 1).End(xlUp).Row

' \\\    drop group level trim into col AY
    Range("AY2:AY" & lrow).FormulaR1C1 = _
        "=VALUE(TRIM(RIGHT(SUBSTITUTE(RC[-50],""."",REPT("" "",LEN(RC[-50]))),LEN(RC[-50]))))"

' \\\    find max for grouping levels
        Range("AY1").FormulaR1C1 = "=MAX((R[1]C:R[99999]C))"
            gmax = Range("AY1").Value

' \\\    loop thru group levels (g), loop rows looking in col AY for any that match g
'           if they match g, mark col AZ with a 1, then group all rows with 1 in col AZ
'           then hide group, and look above for more rows matching g

For g = gmax To 1 Step -1

    For scanRow = lrow To 2 Step -1
        If Range("AY" & scanRow) = g Then
            Range("AZ" & scanRow) = 1
        End If
    Next scanRow

' \\\    define group range
          EndRow = Cells(Cells.Rows.Count, "AZ").End(xlUp).Row
jumpin1:
    If g = 1 Then
        StartRow = 3
            Else
        StartRow = Range("AZ" & EndRow).End(xlUp).Row
    End If
        Rows(StartRow & ":" & EndRow).Rows.Group
            Rows(StartRow & ":" & EndRow).Rows.EntireRow.Hidden = True

' \\\    check above for more rows in same group level
    nextblank = Range("AZ" & StartRow).End(xlUp).Row

       If nextblank > 2 Then
            EndRow = Range("AZ" & nextblank).Row
                GoTo jumpin1

            Else
                End If

' \\\    clear col AY for next level (g)
    ActiveSheet.Columns(52).ClearContents


Next g

' \\\    final top level grouping, catching any docs that are attached to top level mat #
    Rows("3:" & lrow).Rows.Group
        ActiveSheet.Outline.ShowLevels RowLevels:=3

' \\\    clear col AY and AZ
ActiveSheet.Columns(52).ClearContents
ActiveSheet.Columns(53).ClearContents

Range("e2").Select


' \\\    Format sheet

' \\\    fix ref des column issue

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Answer 2

Try,

The subgroup must be formed again within the scope of the upper group,

Once in a grouped range, you must cycle and group. Therefore, you can create a group using a recursive function.

Sub test()
    Dim dic As Object
    Dim vDB, vR()
    Dim rngDB As Range, rng As Range
    Dim i As Long, n As Long

    Set dic = CreateObject("Scripting.Dictionary")
    Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp))
    vDB = rngDB

    rngDB.ClearOutline

    For i = 1 To UBound(vDB, 1)
        If Not dic.exists(vDB(i, 1)) Then
            dic.Add vDB(i, 1), vDB(i, 1)
            n = n + 1
            ReDim Preserve vR(1 To n)
            vR(n) = vDB(i, 1)
        End If
    Next i

    rngGroup rngDB, vR

    rngDB.Rows.Group
End Sub
Sub rngGroup(rngDB As Range, v As Variant)
    Dim rng As Range, rngU As Range
    Dim n As Integer, k As Long, z As Long
    Dim rngF As Range, rngS As Range

    For z = 2 To UBound(v)
        For Each rng In rngDB

            If n <= UBound(v) Then
                s = v(z)
                If rng <> v(z - 1) And rng = s Then
                    If rngU Is Nothing Then
                        Set rngU = rng
                    Else
                        Set rngU = Union(rng, rngU)
                    End If
                End If
            End If
        Next rng
        If Not rngU Is Nothing Then
            k = rngU.Areas.Count

            For j = k To 2 Step -1
                    Set rngF = rngU.Areas(j)
                    Set rngS = rngU.Areas(j - 1)

                    rngGroup rngF, v

                    Set rng1 = rngF.Range("a" & rngF.Rows.Count).Offset(1, 0)
                    Set rng2 = rngS.Range("a1").Offset(-1, 0)
                    Range(rng1, rng2).Rows.Group
            Next
       End If
    Next z
End Sub

Result Image