sum up total quantity

[freezefiz]

I've found this great code which deletes duplicated rows.
And it'll be great if i could get some help in modifying it so as to achieve my desired output.

Dim lngTMP As Long, iRows As Long
    On Error GoTo Fin
    Application.ScreenUpdating = False
    iRows = Cells(Cells.Rows.Count, 2).End(xlUp).Row
    For lngTMP = iRows To 6 Step -1
        If WorksheetFunction.CountIf(Columns(2), Cells(lngTMP, 2)) > 1 Then
 Rows(lngTMP).Delete
        End If
 Next lngTMP
Fin:
    Application.ScreenUpdating = True

Before combining :

protoV6.xls
	A	B	C	D
1	PrepareDate:	6/18/2008
2	Day:	Wednesday
3	DeliverDate:
4	ProductID	Product	Uom	Qty
5	TDG-**002	TunaCheesePizzaBar(KG)	KG	30
6	RFG-**588	ThaiChickenFriedRice(KG)	KG	30
7	RFG-**502	ClubSandwich(PKT)	PKT	3
8	RFG-**501	RoastMexicanChicken(PKT)	PKT	15
9	RFG-**501	RoastMexicanChicken(pcs)	pcs	12
10	TDG-**002	TunaCheesePizzaBar(pcs)	pcs	15
11	RFG-**501	RoastMexicanChicken(KG)	KG	10
12	TDG-**002	TunaCheesePizzaBar(KG)	KG	30
13	RFG-**588	ThaiChickenFriedRice(KG)	KG	30
14	RFG-**502	ClubSandwich(PKT)	PKT	3
15	RFG-**501	RoastMexicanChicken(PKT)	PKT	15
16	RFG-**501	RoastMexicanChicken(pcs)	pcs	12
17	TDG-**002	TunaCheesePizzaBar(pcs)	pcs	15
18	RFG-**501	RoastMexicanChicken(KG)	KG	10
19	TDG-**002	TunaCheesePizzaBar(KG)	KG	30
20	RFG-**588	ThaiChickenFriedRice(KG)	KG	30
21	RFG-**502	ClubSandwich(PKT)	PKT	3
22	RFG-**501	RoastMexicanChicken(PKT)	PKT	15
23	RFG-**501	RoastMexicanChicken(pcs)	pcs	12
24	TDG-**002	TunaCheesePizzaBar(pcs)	pcs	15
25	RFG-**501	RoastMexicanChicken(KG)	KG	10
GrandTotal

As shown below, the duplicated rows are deleted, and unfortunately this also means that the quantity for that row is also deleted.

But i would like is to sum up all the qty for that product & so only the total will be displayed.

After combining :

protoV6.xls
	A	B	C	D
1	PrepareDate:	6/18/2008
2	Day:	Wednesday
3	DeliverDate:
4	ProductID	Product	Uom	Qty
5	TDG-**002	TunaCheesePizzaBar(KG)	KG	30
6	RFG-**588	ThaiChickenFriedRice(KG)	KG	30
7	RFG-**502	ClubSandwich(PKT)	PKT	3
8	RFG-**501	RoastMexicanChicken(PKT)	PKT	15
9	RFG-**501	RoastMexicanChicken(pcs)	pcs	12
10	TDG-**002	TunaCheesePizzaBar(pcs)	pcs	15
11	RFG-**501	RoastMexicanChicken(KG)	KG	10
GrandTotal

Pls Advise.
Thanks.

 

[cornflakegirl]

Why not use a pivot table?

 

[freezefiz]

thanks for the reply.

well that may be a great suggestion but my data is dynamic,
is that possible to implement it on pivot table?

 

[cornflakegirl]

By dynamic, do you mean the range size changes? You could specify a dynamic range as the source for the pivot table.

 

[freezefiz]

well yes, the range size changes & also the values.

there may be times when some of the products might not be needed.

And also, these data are taken from yet another table.

hmm emma, is there any other possible way of doing this?

 

[cornflakegirl]

What does the original table look like? Could you do a pivot on that?

Values changing not a problem - you just refresh the pivot table. Some products not being there not an issue either - the pivot would deal with that too. (Unless you mean that you would need a row with the product name and a zero - you wouldn't get that unless the product name was in the source data with a zero - but I don't think you do mean that?)

 

[Simon Lloyd]

Here's something i created for someone else but have adapted it to your needs, it assumes your data is on a sheet called data and the result will go to a sheet called Output:

Sub Find_Dups_Sum_To_New_Sheet()
    Dim MyData As Worksheet, MyOutput As Worksheet
    Dim Lrow As Long, LrowDst As Long
    Dim Rng As Range
    Set MyData = Worksheets("Data")
    Set MyOutput = Worksheets("Output")
    MyOutput.Cells.ClearContents
    Lrow = MyData.Range("A" & Rows.Count).End(xlUp).Row
    MyData.Range("A1:D" & Lrow).AdvancedFilter xlFilterCopy, , MyOutput.Range("A1"), True
    MyOutput.Range("C4") = "Totals"
    LrowDst = MyOutput.Range("A" & Rows.Count).End(xlUp).Row
    MyOutput.Range("C5:C" & LrowDst) = "=SUMIF(Data!$B$5:$B$200,B5,Data!$D$5:$D$200)"
     
End Sub

if you really want the Uom transporting over too then you need something in the C1:C3 for the advanced filter to recognise it!
EDIT: You will also need to change these lines:

MyOutput.Range("C4") = "Totals"
    LrowDst = MyOutput.Range("A" & Rows.Count).End(xlUp).Row
    MyOutput.Range("C5:C" & LrowDst) = "=SUMIF(Data!$B$5:$B$200,B5,Data!$D$5:$D$200)"

for:

 MyOutput.Range("D5") = "Totals"
    LrowDst = MyOutput.Range("A" & Rows.Count).End(xlUp).Row
    MyOutput.Range("D5:D" & LrowDst) = "=SUMIF(Data!$B$5:$B$200,B5,Data!$D$5:$D$200)"

 

[freezefiz]

Hey Simon.

Thank you so much for the codes! It worked perfectly!

hmm about the 'uom' column..
i did try to modify :

Lrow = MyData.Range("A" & Rows.Count).End(xlUp).Row
    MyData.Range("A1:D" & Lrow).AdvancedFilter xlFilterCopy, ,    MyOutput.Range("A1"), True
    MyOutput.Range("C1") = "AA"
    MyOutput.Range("C2") = "BB"
   MyOutput.Range("C3") = "BB"
   MyOutput.Range("C4") = "uom"
    MyOutput.Range("D4") = "Totals"
    LrowDst = MyOutput.Range("A" & Rows.Count).End(xlUp).Row
    MyOutput.Range("D5:D" & LrowDst) = "=SUMIF(GrandTotal!$B$5:$B$200,B5,GrandTotal!$D$5:$D$200)"

But the whole uom col didn't appear..
Am i missing something out here..?

Thanks.

 

[jindon]

Not sure if this is what you wanted ...
try

Sub test()
Dim a, i As Long, ii As Long, b(), n As Long, z As String
With Range("a5", Range("a" & Rows.Count).End(xlUp)).Resize(,4)
    a = .Value
    ReDim b(1 To UBound(a,1), 1 To UBound(a,2))
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a,1)
            z = a(i,1) & ";" & a(i,2)
            If Not .exists(z) Then
                n = n + 1 : .add z, n
                For ii = 1 To UBound(a,2) : b(n,ii) = a(i,ii) : Next
            End If
        Next
    End With
    .Value = b
End With
End Sub

 

[ExcelPr0]

Ah. Much Clearer now.
Jindon: I tested your code, it didn't add up the quantity value.
I could be wrong, but it seems that she wants to add up the quantity as well.