PDA

View Full Version : Merge similar rows...



Cinema
11-04-2016, 03:52 AM
Hi,

I want to combine (sum up) all the rows that have the same name (value in the first columns).
I found a macro that does the job but it assumes that the rows that need to be merged are not scattered, and can only appear one after another.

How to write this macro for scattered rows?



Sub Combine()

LastRow = ActiveSheet.UsedRange.Rows.Count
Set r = ActiveSheet.UsedRange.Resize(1)
With Application.WorksheetFunction
For iRow = LastRow - 1 To 2 Step -1
Do While Cells(iRow, 1) = Cells(iRow + 1, 1)
LastCol = r(r.Count).Column
SumCol = LastCol
For iCol = 2 To SumCol
Cells(iRow, iCol) = .Sum(Range(Cells(iRow, iCol), Cells(iRow + 1, iCol)))
Next iCol
Rows(iRow + 1).Delete
Loop
Next iRow
End With
End Sub

MickG
11-04-2016, 07:22 AM
Try this:-


Sub Del()
Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long, Ac As Long, nRng As Range
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn
Else
For Ac = 1 To Lst - 1
.Item(Dn.Value).Offset(, Ac).Value = _
.Item(Dn.Value).Offset(, Ac).Value + Dn.Offset(, Ac)
Next Ac
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 With
End Sub

Cinema
11-04-2016, 08:23 AM
Hi MickG,

that works perfect. Thank you :)

MickG
11-05-2016, 03:30 AM
You're welcome

Cinema
11-09-2016, 03:32 AM
Hallo,

I do have Problems :( The code just deletes the duplicate rows but does not sum up.

snb
11-09-2016, 05:13 AM
It does, but you will have to write the result somewhere.
But why don't you use a pivottable ?
And why don't you post a sample file ?

MickG
11-09-2016, 06:46 AM
Have you got any data in row 1, this is the row that the code looks at to decide how many columns you have.
You need to have data in row 1 in all the columns you want to add, to get then to sum.