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