level wise repeat rows for sku

[sachin483]

i have level wise hierarchy i want to post the data at sku level for every hierarchy , and the bottom level no is 4 and all the above level are the summation of level 4 , hence for each level all the sku lines will get repeated and sum for level 3 , 2 , 1

[HansV]

Will DIV always be TT?
Will QTY and VAL always be the same for T1 and T2?

[sachin483]

Div means division they will be different , qty and val will different for each and every at level 4

[HansV]

Please attach a sample workbook with more realistic data: at least two different DIVs, and different values for QTY and VAL for different level 4.
Include the expected result.

[sachin483]

Please find enclosed attached data

[HansV]

There's still only one division...

[sachin483]

Please find enclosed attached data for 2 divisions

[HansV]

OK, I can work with that. But this is MUCH more complicated than the example that you originally posted.
In the future, please help us to help you, and provide a realistic, representative example in the first post, instead of only doing so after repeated questions.
Finding a solution will take a while.

[HansV]

Here is a macro. It is very slow, and the results don't exactly match yours, but I think that's because yours are incorrect in some places.

Code: Select all

Sub CreateList()
    Dim List1() As Variant
    Dim Rang2 As Range
    Dim List2() As Variant
    Dim List3() As Variant
    Dim Dict1 As Object
    Dim Dict2 As Object
    Dim DIV As String
    Dim LEV As Long
    Dim LCD As String
    Dim LCD2 As String
    Dim SKUs() As Variant
    Dim SKU As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim QTY As Long
    Dim VAL As Double
    Dim r As Long
    Const c = 12 ' Output starts in column L
    Application.ScreenUpdating = False
    r = 2
    List1 = Range(Range("A2"), Range("C2").End(xlDown)).Value
    Set Rang2 = Range(Range("E3"), Range("J2").End(xlDown))
    List2 = Rang2.Value
    For i = 2 To UBound(List1)
        If List1(i, 1) <> List1(i - 1, 1) Then
            DIV = List1(i, 1)
            Set Dict2 = CreateObject(Class:="Scripting.Dictionary")
            For j = 1 To UBound(List2)
                If List2(j, 1) = DIV Then
                    Dict2(List2(j, 4)) = 1
                End If
            Next j
            SKUs = Dict2.Keys
        End If
        LEV = List1(i, 2)
        LCD = List1(i, 3)
        For Each SKU In SKUs
            r = r + 1
            Cells(r, c).Value = DIV
            Cells(r, c + 1).Value = LEV
            Cells(r, c + 2).Value = LCD
            Cells(r, c + 3).Value = "'" & SKU
            QTY = 0
            VAL = 0
            j = i
            Do While List1(j, 1) = DIV
                If List1(j, 2) = 4 Then
                    LCD2 = List1(j, 3)
                    QTY = QTY + Application.SumIfs(Rang2.Columns(5), Rang2.Columns(1), _
                        DIV, Rang2.Columns(3), LCD2, Rang2.Columns(4), SKU)
                    VAL = VAL + Application.SumIfs(Rang2.Columns(6), Rang2.Columns(1), _
                        DIV, Rang2.Columns(3), LCD2, Rang2.Columns(4), SKU)
                End If
                j = j + 1
                If j > UBound(List1) Then Exit Do
                If List1(j, 2) <= LEV Then Exit Do
            Loop
            
            Cells(r, c + 4).Value = QTY
            Cells(r, c + 5).Value = VAL
        Next SKU
    Next i
    Application.ScreenUpdating = True
End Sub

[sachin483]

Thanks a lot working fine but a little request to add column (position-column 'D') in format to result value so that unique level code can be carried (cells highlighted) if repeated

[HansV]

Code: Select all

Sub CreateList()
    Dim List1() As Variant
    Dim Rang2 As Range
    Dim List2() As Variant
    Dim List3() As Variant
    Dim Dict1 As Object
    Dim Dict2 As Object
    Dim DIV As String
    Dim LEV As Long
    Dim LCD As String
    Dim LCD2 As String
    Dim POS As String
    Dim SKUs() As Variant
    Dim SKU As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim QTY As Long
    Dim VAL As Double
    Dim r As Long
    Const c = 12 ' Output starts in column L
    Application.ScreenUpdating = False
    r = 2
    List1 = Range(Range("A2"), Range("D2").End(xlDown)).Value
    Set Rang2 = Range(Range("E3"), Range("J2").End(xlDown))
    List2 = Rang2.Value
    For i = 2 To UBound(List1)
        If List1(i, 1) <> List1(i - 1, 1) Then
            DIV = List1(i, 1)
            Set Dict2 = CreateObject(Class:="Scripting.Dictionary")
            For j = 1 To UBound(List2)
                If List2(j, 1) = DIV Then
                    Dict2(List2(j, 4)) = 1
                End If
            Next j
            SKUs = Dict2.Keys
        End If
        LEV = List1(i, 2)
        LCD = List1(i, 3)
        POS = List1(i, 4)
        For Each SKU In SKUs
            r = r + 1
            Cells(r, c).Value = DIV
            Cells(r, c + 1).Value = LEV
            Cells(r, c + 2).Value = LCD
            Cells(r, c + 3).Value = POS
            Cells(r, c + 4).Value = "'" & SKU
            QTY = 0
            VAL = 0
            j = i
            Do While List1(j, 1) = DIV
                If List1(j, 2) = 4 Then
                    LCD2 = List1(j, 3)
                    QTY = QTY + Application.SumIfs(Rang2.Columns(5), Rang2.Columns(1), _
                        DIV, Rang2.Columns(3), LCD2, Rang2.Columns(4), SKU)
                    VAL = VAL + Application.SumIfs(Rang2.Columns(6), Rang2.Columns(1), _
                        DIV, Rang2.Columns(3), LCD2, Rang2.Columns(4), SKU)
                End If
                j = j + 1
                If j > UBound(List1) Then Exit Do
                If List1(j, 2) <= LEV Then Exit Do
            Loop
            
            Cells(r, c + 5).Value = QTY
            Cells(r, c + 6).Value = VAL
        Next SKU
    Next i
    Application.ScreenUpdating = True
End Sub

[sachin483]

Thank a ton working fine

[snb]

Maybe this is faster:
I defined a 'dynamic' table for range F1:K89, including a totals row.