Nested loops to extract data from table-CodePudding

i'm searching a way to extract data from a table (on sheet1) in this sense:
COLUMN_A - has the material code of our components. may appear once or more
COLUMN_B - has the warehouse areas. for each material code, it can have 1 or more warehouse areas
COLUMN_C - has the qty on each warehouse areas for each material code. it appears only the qty >0
Please see picture:

I want to loop in this table , to build a new sheet (on sheet2) which is basically:

So I have to take each code, paste it in sheet2 and add as many rows as many are the warehouse areas in sheet1, writing the name of warehouse areas in column C of sheet 2 in the picture "end table", you can see how manually i realized it.. is there a way with VBA and loops to obtain it easilly?

I've done something similar but with fixed cells (meaning for each code I had 5 rows), but never with such dynamic range of rows..

Big kudos to whoever can help me with this!! thanks Andrea

CodePudding user response：

If I understand what you want correctly, maybe something like this ?

Sub test()
Dim rgSrc As Range: Dim rg As Range: Dim cell As Range
Dim oFill As Range: Dim oStart As Range: Dim rc As Long
Dim el: Dim arr

With Sheets("Sheet1")
    Set rgSrc = .Range("A4", .Range("A" & Rows.Count).End(xlUp))
End With

With Sheets("Sheet2")
    Set oStart = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Set oFill = oStart
End With

Set arr = CreateObject("scripting.dictionary")
For Each cell In rgSrc: arr.Item(cell.Value) = 1: Next

For Each el In arr
    With rgSrc
        .Replace el, True, xlWhole, , False, , False, False
        rc = Application.CountIf(rgSrc, True)
        Set rg = .SpecialCells(xlConstants, xlLogical)
        .Replace True, el, xlWhole, , False, , False, False
    End With
    Union(rg, rg.Offset(0, 1), rg.Offset(0, 2)).Copy Destination:=oFill
    Set oFill = oFill.Offset(rc, 0)
Next
    
With Range(oStart, oStart.End(xlDown)).Offset(0, 2)
    If Not .Find(0, lookat:=xlWhole) Is Nothing Then
        .Replace 0, True, xlWhole, , False, , False, False
        .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
    End If
End With
    
Range(oStart.Offset(0, 1), oStart.Offset(0, 1).End(xlDown)).Cut oStart.Offset(0, 2)

End Sub

What the code do :
Create a range of data under "Materiale" of Sheet1 as rgSrc variable. It starts from cell A4 to whatever is the last row of the data.

Create a range to fill in Sheet2 under "MATERIAL" column as oFill variable, and also make oStart variable the same range as oFill.

It create an array of the unique value from the range of the data under "Materiale" (the rgSrc variable). Then it loop to each element in the array as el variable, get the range of cells which contains the looped el value then put the result into oFill.

After the loop done, it delete all rows in column C of sheet2 which value is zero. Then it move the value in column B to column C.

CodePudding user response：

to improve the explanation of what I want to do: take sheet1 - columnA (Material code) -> in this column, a material code can be present more than once, or just 1 time only. i want to put each of this code in sheet2 - columnA.

For each code, i want to take all warehouse areas that are in sheet1 and copy them in sheet2 - columnC, under the respective code.

all codes from sheet1 will change every week.

So i will have something like this:

sheet1 A B C a pdvd 100 b dep2 200 c pdph 200 a dep2 10000 a pdph 130

in sheet2, i'll have A B C a pdvd 100 a dep2 10000 a pdph 130 b dep2 200

this until the end of all rows.. is that clear? will your script work in this way?

BR Andrea