VBA check column for duplicate products and sum their quantity in another column

[matija385hr]

Hi all,

I have in 4 columns by order: Order number, Product, Quantity, Note.

What I need to do is to check in Sheet "Products" column B (Product) for duplicates, sum their quantities (column C) and put them in another sheet "Group", but only if column D (Notes) is empty. If there is something in Column D, it should be pasted to another sheet "Group" (product, quantity and note).

I found this code from MickG, but don't know how to alter it to fit my needs

Thank you in advance

Sub MG14May26
Dim Rng As Range, Dn As Range, n As Long, nRng As Range, nCol As Long
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
nCol = ActiveSheet.Cells(1).CurrentRegion.Columns.Count
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn
    Else
        If nRng Is Nothing Then Set nRng = _
        Dn Else Set nRng = Union(nRng, Dn)
        .Item(Dn.Value).Offset(, 3) = .Item(Dn.Value).Offset(, 3) + Dn.Offset(, 3)
    End If
Next
For Each Dn In nRng
    Dn.Resize(, nCol).ClearContents
Next Dn
Rng.Resize(, nCol).Sort Key1:=Range("A2"), Order1:=xlAscending
End With
End Sub

 

[JLGWhiz]

it should be pasted to another sheet "Group" (product, quantity and note).

What does the 'it' refer to in this statement. Your description is unclear as to what exactly you you want to display in sheet 'Group'. Do you want to filter by product and place all rows of all four columns of that product in sheet 'Group" but only total if there are notes in column 4? I am confused. Please refrain from using non specific pronouns like 'it' and 'them'. Use the names of the items, data, sheets, etc. That way we will know what you mean.[/Quote]

 

[matija385hr]

Sorry for confusion.

I have one workbook with two sheets - Sheet Total and Sheet Group.

In Sheet Total I have 4 columns - Order #, Product, Quantity, Notes. I need to check cell values through column B (Product) in Sheet Total, and paste values in Sheet Group without duplicates. If Product is duplicate, in Sheet Group should be only one value, and quantities summed from Sheet Total. If column D in Sheet Total is not empty, than this product should be pasted to Sheet Group and quantities not summed with other same products.

So, i have this in Sheet Total:

A B C D
1 Prod A 1
1 Prod B 2
2 Prod A 2
2 Prod B 2
3 Prod A 1 Note random text
3 Prod B 2 Note radnom text

And should get this in Sheet Group

A B C
Prod A 3
Prod B 4
Prod A 1 Note random text
Prod B 2 Note random text

Hope this helps.

KR,
Matija

 

[JLGWhiz]

Give this a try

Sub t()
Dim c As Range, qty As Long, sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range, fn As Range, adr As String
Set sh1 = Sheets("Products")
Set sh2 = Sheets("Group")
    With sh1
        lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
        Set rng = .Range("B1", .Cells(Rows.Count, 2).End(xlUp))
        rng.AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
        For Each c In .Cells(lr + 2, 1).CurrentRegion.Offset(1)
            If c <> "" Then
                Set fn = rng.Find(c.Value, , xlValues, xlWhole)
                    If Not fn Is Nothing Then
                        adr = fn.Address
                        Do
                            If fn.Offset(, 2) = "" Then
                                qty = qty + fn.Offset(, 1).Value
                            End If
                            Set fn = rng.FindNext(fn)
                        Loop While fn.Address <> adr
                        sh2.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
                        sh2.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = qty
                    End If
                    qty = 0
            End If
        Next
        For Each c In .Cells(lr + 2, 1).CurrentRegion.Offset(1)
            If c <> "" Then
                Set fn = rng.Find(c.Value, , xlValues, xlWhole)
                    If Not fn Is Nothing Then
                        adr = fn.Address
                        Do
                            If fn.Offset(, 2) <> "" Then
                                fn.Resize(, 3).Copy sh2.Cells(Rows.Count, 1).End(xlUp)(2)
                            End If
                            Set fn = rng.FindNext(fn)
                        Loop While fn.Address <> adr
                    End If
            End If
        Next
        .Cells(lr + 2, 1).CurrentRegion.ClearContents
    End With
End Sub

 

[matija385hr]

Sorry, it doesn't work for me. To be honest, i didn't see any change.

I'm posting images of how it should look and what should vba do.

 

[JLGWhiz]

This is my test set up and results.
Sheet products

TestBase.xlsm
	A	B	C	D
1	ord	prod	aty	note
2	1	abc	2
3	1	abc	3
4	1	def	1
5	1	abc	4	blah, blah
6	2	cde	2
7	2	cde	1	blagh
8	2	abc	3
9	3	abc	2
10	3	def	1
11	3	ghi	4
12	3	ghi	1	xxxxx
Products

sheet Group

TestBase.xlsm
	A	B	C
1	prod	qty	note
2	abc	10
3	def	2
4	cde	2
5	ghi	4
6	abc	4	blah, blah
7	cde	1	blagh
8	ghi	1	xxxxx
Group

Check your sheet names, column references, etc. against the code to make sure there are no typos or orther differences betweent the code and your worksheets. the only one I see is this line needs to be modified to start the range on B3 instead of B1.

Set rng = .Range("B3", .Cells(Rows.Count, 2).End(xlUp))

 

[matija385hr]

Sorry, I altered rng to be from B3 which is my starting point, and now it works.

The only problem is that one product is repeated twice in Group sheet, ones with quantity 0 and ones with real quantity. I'm sending screenshots of Products sheet and Group sheet.

 

[JLGWhiz]

That is not a code problem, that is a sheet integrity problem. scroll down on your Products sheet and you will likely find an entry for that item somewhere in column B. Or in a hidden row.

 

[matija385hr]

This is strange. I don't have any hidden rows, and while using ctrl+F to find that product, it finds only one. To be safe, I also selected all sheet and unhide all rows, but result is still the same - just one product with name Podnica Plus 200x70

 

[matija385hr]

OK, I figured out that this problem is with all products having note in column D.
I just now altered the product list with other products, and please see the result in printscreens.