Re: Merge duplicate rows and sum value
Try this for results on sheet2.
Sub nSum()
Dim Rng As Range, Dn As Range, n As Long, Txt As String, Ac As Long
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 5)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
Txt = Join(Application.Transpose(Application.Transpose(Dn.Resize(, 4))), ",")
If Not .Exists(Txt) Then
n = n + 1
For Ac = 1 To 5: ray(n, Ac) = Dn.Offset(, Ac - 1): Next Ac
.Add Txt, n
Else
ray(.Item(Txt), 5) = ray(.Item(Txt), 5) + Dn.Offset(, 4)
End If
Next
n = .Count
End With
With Sheets("Sheet2").Range("A1").Resize(n, 5)
.Value = ray
.Borders.Weight = 2
.Columns.AutoFit
End With
End SubRe: Merge duplicate rows and sum value
You're welcome
Re: Merge duplicate rows and sum value
Hi MickG, I came across this vb code of yours, and try to use it on my sheet, but doesnt seems to work, can you help me out with this?
My example:
Floor Fan Equipment Size Quantity Unit Remarks
GF FAF Fire Damper 300X500 13 Nos
GF FAF Fire Damper 500X500 1 Nos Wired
GF FAF Fire Damper 300X500 10 Nos
FF FUF VCD 400X400 2 Nos
GF FUF VCD 300X300 13 Nos
Result:
Floor Fan Equipment Size Quantity Unit Remarks
GF FAF Fire Damper 300X500 23 Nos
GF FAF Fire Damper 500X500 1 Nos Wired
FF FUF VCD 400X400 2 Nos
GF FUF VCD 300X300 13 Nos
Your help will be greatly appreciated. Thank you
Re: Merge duplicate rows and sum value
On the basis that your data starts "A2", has a max of 7 columns and you want the result based on the first 4 columns, Try this:-
NB:- This code will alter your data.
Sub DelDupAdd()
Dim Rng As Range, Dn As Range, n As Long, Dic As Object, Txt As String, nRng As Range
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng
With Application
Txt = Join(.Transpose(.Transpose(Dn.Resize(, 4))), ",")
End With
If Not Dic.Exists(Txt) Then
Dic.Add Txt, Dn
Else
Dic(Txt).Offset(, 4).Value = Dic(Txt).Offset(, 4).Value + Dn.Offset(, 4).Value
If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End Sub
Regards Mick
I tried to alter but seems not working for me: I basically want to combine rows where invoice number is duplicate & at the same time sum up invoice amount & tax amount. Please help : screenshot below
Don’t have an account yet? Register yourself now and be a part of our community!