Extract data based on cells names across sheets

Hello
I have many spesific cells and columns containns names , what I want matching amongst sheets DETAILS with TABLE 3,TABLE 4 then should brings all of data where next to adjacent cell for cell name or under it .
the cells ,columns as I put in sheet DETAILS(DISTRIBUTOR CODE,SHIPMENT DATE,DESTINATION,PRODUCT CODE,BRAND,QTY,TOTAL SHIPMENT QTY,CONTR#,SEAL#). and if the rows are alittle and the BRAND are more than rows inserted in sheet DETAILS then should add before TOTAL SHIPMENT QTY rows with the same borders . and if there is duplicate item as column B( BARND) should merge and sum the values whether duplicates item are in the same sheet or across sheets as in item 1,4 as I put the result in sheet expected . as to TOTAL SHIPMENT QTY,DISTRIBUTOR CODE,SHIPMENT DATE will repeat for each separated range should just choose one of them and ignore the rest .

Hello,

each time both source data worksheets are for the same disdributor ?
If not attach a better workbook sample well reflecting the case ...

Hi Marc

each time both source data worksheets are for the same disdributor ?

yes multiple separated range for the same distributor . what's the problem for this ?
when you get the value in sheet details will bring the same value . as I said

as to TOTAL SHIPMENT QTY,DISTRIBUTOR CODE,SHIPMENT DATE will repeat for each separated range should just choose one of them and ignore the rest .

According to your attachment a VBA demonstration for starters to paste to the Worksheet____1 (Details) worksheet module :

PHP Code: 

Sub Demo1()
  Const G = 1, K = 3
    Dim N&, Rg As Range, M&, W(), L&, R&, V, C%
        With Sheets(2):  [B1] = .[B1]:  [B2:B3] = .[D1:D2].Value:  End With
    For N = 2 To 3
    For Each Rg In Sheets(N).UsedRange.Columns(1).SpecialCells(2).Areas
        M = M + 1
        ReDim Preserve W(1 To M)
        W(M) = Rg.CurrentRegion
    Next Rg, N
    With New Collection
        For N = 2 To M Step 2
        For L = 2 To UBound(W(N))
            W(N)(L, G) = CStr(W(N)(L, G))
        For R = 1 To .Count
               V = StrComp(.Item(R), W(N)(L, G))
            If V >= 0 Then
                If V Then .Add W(N)(L, G), , R
                Exit For
            End If
        Next
            If R > .Count Then .Add W(N)(L, G)
        Next L, N
            For R = 1 To .Count:  .Add R, .Item(R), R:  .Remove R + 1:  Next
            ReDim V(1 To .Count, K)
        For N = 2 To M Step 2
        For L = 2 To UBound(W(N))
                R = .Item(W(N)(L, G))
            If IsEmpty(V(R, G)) Then
                V(R, 0) = R
                For C = 1 To K:  V(R, C) = W(N)(L, C):  Next
            Else
                V(R, K) = V(R, K) + W(N)(L, K)
            End If
        Next L, N
            R = .Count
    End With
        L = R - 4
        If L > 0 Then Rows(8).Resize(L).Insert: L = L + 14 Else L = 14
    With [A6].Resize(R, K + 1)
        .Value = V
        .Cells(R + 1, K + 1) = Application.Sum(.Columns(K + 1)) & " pcs"
    End With
        ReDim V(1 To M / 2, 1 To 3)
        R = 0
    For N = 1 To M - 1 Step 2
        R = R + 1
        V(R, 1) = R
        V(R, 2) = W(N)(2, 2)
        V(R, 3) = W(N)(3, 2)
    Next
        If R > 3 Then Rows(L + 1).Resize(R - 3).Insert
        Cells(L, 1).Resize(R, 3) = V
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon ? ★ Add Reputation ? ! ◄ ◄

Thanks , but doesn't arrange data as I expect . you can see so.

No issue on my side and as I wrote 'According to your attachment' so try at least with exactly the same initial post attachment !

No issue on my side and as I wrote 'According to your attachment'

strange !!

so try at least with exactly the same initial post attachment !

actually the same file.
well, I will check it again and come back soon.

the problem still continues

OK this problem occures when run macro more than one time .I accep to t clear data in sheet details before brings data to replace data if update in others sheets. how can I fix this problem,please?

As it was according to your iniitial explanation with rows to be inserted etc ...

If you need to keep the Details worksheet cell formatting so you will need to amend this worksheet
with adding the SUM formula in cell D10 and naming two ranges
or if you don't need to keep the actual cell formatting an easy way is to clear the Details worksheet and copy the raw data ?

As it depends also on what you forgot to explain in your initial post :
does some data need to be sorted or just keep the original order ?
The better explanation, the less mods you will have to do ...

actually I want to keep the Details worksheet cell formatting.
when sort the data de[depends on column B . as you see sort numbers from small to big .
your code does work as what I want except clear data before brings any thing to replace the last updating .

Sort only products in second range, but about the third range (seals) ?

Ok also should sort from small to big about third range(seals)

According to your initial post attachment and to Excel basics you must first name two ranges in Details worksheet :

• cells A5:D10 as _PRODUCTS
  
  
• cells A13:C16 as _SEALS

Download the below attachment and rename it just removing at end .txt in order it becomes a .cls file.


Import this Sorted Collection class module file on VBE side via a right click on your project.
Once done you must see the SCollection class module within your VBA project.


Once ranges named and the class module imported try this new VBA demonstration for starters
to paste only to the Worksheet____1 (Details) worksheet module :

PHP Code: 

Sub DemoSCollection1()
  Const G = 1
    Dim N&, W(), M&, L&, oCol As New SCollection, K%, V(), R&, C%
    For N = 2 To 3
        With Sheets(N).UsedRange.Columns(1).SpecialCells(2).Areas
            ReDim Preserve W(1 To M + .Count)
            For L = 1 To .Count:  M = M + 1:  W(M) = .Item(L).CurrentRegion.Value2:  Next
        End With
    Next
        [B1:B3] = Application.Transpose(Array(W(1)(1, 2), W(1)(1, 4), W(1)(2, 4)))
    With [_PRODUCTS].Rows
       .Item("2:" & .Count - 1).ClearContents
        For N = 2 To M Step 2:  oCol.AddColumn W(N), 2, G:  Next
        If oCol.Count Then oCol.IndexItemsAsKeys Else Exit Sub
        K = .Columns.Count - 1
        ReDim V(1 To oCol.Count, K)
    For N = 2 To M Step 2
    For L = 2 To UBound(W(N))
            R = oCol(W(N)(L, G))
        If IsEmpty(V(R, G)) Then
            V(R, 0) = R
            For C = 1 To K:  V(R, C) = W(N)(L, C):  Next
        Else
            V(R, K) = V(R, K) + W(N)(L, K)
        End If
    Next L, N
       .Cells(.Count, K + 1) = W(1)(5, 4)
        If oCol.Count > .Count - 2 Then .Item(3).Resize(oCol.Count - .Count + 2).Insert
       .Item(2).Resize(oCol.Count) = V
    End With
        oCol.Reset
    With [_SEALS].Rows
       .Item("2:" & .Count).ClearContents
        For N = 1 To M - 1 Step 2:  oCol.Add W(N)(3, 2):  Next
        If oCol.Count Then oCol.IndexItemsAsKeys Else Exit Sub
        ReDim V(1 To oCol.Count, 1 To .Columns.Count)
        For N = 1 To M - 1 Step 2:  R = oCol(W(N)(3, 2)):  V(R, 1) = R:  V(R, 2) = W(N)(2, 2):  V(R, 3) = W(N)(3, 2):  Next
        If oCol.Count >= .Count Then .Item(3).Resize(oCol.Count + 1 - .Count).Insert
       .Item(2).Resize(oCol.Count) = V
    End With
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon ? ★ Add Reputation ? ! ◄ ◄

despite of the code became complex but the code works greatly
thanks very much

Thanks for the rep' !

The sorted Collection class module simplifies the VBA procedure like you can compare with the first demonstration.

If your real workbook has the same few data
so a beginner level Excel basics VBA procedure can achieve the same result in the same short time ...