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

matija385hr

New Member
Joined
Mar 14, 2020
Messages
20
Office Version
  1. 365
Platform
  1. Windows
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

VBA Code:
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
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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]
 
Upvote 0
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
 
Upvote 0
Give this a try
VBA Code:
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
 
Upvote 0
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.
 

Attachments

  • Products sheet.jpg
    Products sheet.jpg
    79 KB · Views: 54
  • Group sheet.jpg
    Group sheet.jpg
    101.2 KB · Views: 54
Upvote 0
This is my test set up and results.
Sheet products
TestBase.xlsm
ABCD
1ordprodatynote
21abc2
31abc3
41def1
51abc4blah, blah
62cde2
72cde1blagh
82abc3
93abc2
103def1
113ghi4
123ghi1xxxxx
Products


sheet Group
TestBase.xlsm
ABC
1prodqtynote
2abc10
3def2
4cde2
5ghi4
6abc4blah, blah
7cde1blagh
8ghi1xxxxx
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.
Code:
Set rng = .Range("B3", .Cells(Rows.Count, 2).End(xlUp))
 
Last edited:
Upvote 0
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.
 

Attachments

  • Products sheet_1.jpg
    Products sheet_1.jpg
    74.2 KB · Views: 29
  • Group sheet_1.jpg
    Group sheet_1.jpg
    51.5 KB · Views: 29
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 

Attachments

  • Products sheet_2.jpg
    Products sheet_2.jpg
    96.3 KB · Views: 32
  • Group sheet_2.jpg
    Group sheet_2.jpg
    87 KB · Views: 32
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top