Excel VBA: Merge Rows and Sum Values

Question

I have read just about every other question on here on merging rows and consolidating data. I did come across a solution I think will work for me, but when I ran the macro it didn't actually sum the right column. Being new to VBA, I'm having trouble figuring out what needs to change in the macro to work in my sheet.

Background: I want to use a macro because I get a report every day that I have to manipulate so that it can process into our system. I have created a VBA macro to do the manipulation for me, but I have realized that the report now has duplicate lines with different values. Below is an example with the last set of numbers needing to be added together. (Column J on my actual report)

i.e.

Row 1: C3=1234, Name, C5=ABC, C5Name, C4=DEF, C4Name, 21361

Row 2: C3=1234, Name, C5=ABC, C5Name, C4=DEF, C4Name, 132165

This is the solution I found, but I need to know what to change to correspond with the column I actually need summed up.

Sub Merge()

Dim ColumnsCount As Integer
Dim i As Integer

Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
    If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        For i = 1 To ColumnsCount - 1
            ActiveCell.Offset(0, i).Value = ActiveCell.Offset(0, i).Value +     ActiveCell.Offset(1, i).Value
        Next
        ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop

End Sub

Any and all help is greatly appreciated. Please let me know if I need to provide additional information.

~Andrea

On which same columns values will the `j` column be merged? Is there more than one column need to be checked? — kitap mitap, Apr 03 '15 at 17:51
Is one of these columns be taken as an index or they means as a whole? Are duplicate rows succesive? because your code orders the column which it merges first and then merges succesive rows if they are same. Do you want your code order? — kitap mitap, Apr 03 '15 at 18:22
So, the first part should sort all the data. I actually modified that to include 3 columns so all the duplicates are grouped. — Adiamond, Apr 03 '15 at 18:46
OK. Then, first sort the data so the duplicates is succesive. Then in a loop, compare which columns are enough to be sure that the rows are duplicate each other.; then sum the second column j value to the first; at last delete the second row; after deleting a row substract one from the counter. (this substracting is important) By the way, your code works on a single column and deletes duplicates in that column when merging them by summing. It may be a good idea to merge enough number of -may be all- columns in a column for ordering and comparing. Which column is that? — kitap mitap, Apr 03 '15 at 19:18
My previous commnt's last sentences should be like this: "It may be a good idea to merge enough number of -may be all- columns -except j- in a column for ordering and comparing. Which column is that?" — kitap mitap, Apr 03 '15 at 19:47

user1016274 · Answer 1 · 2015-04-06T20:32:45.260

0

You don't have to loop through all columns just to add column J's values:

    If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(0, 10).Value = ActiveCell.Offset(0, 10).Value +     ActiveCell.Offset(1, 10).Value
        ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
    Else
        ActiveCell.Offset(1, 0).Select
    End If

BTW, are you sure you want to increment the active cell's row only if the row is not duplicated? Might be that it works because of the DeleteRow operation but I just wanted to ask.
edit: deleted orphaned Next statement, sorry.

edited Apr 06 '15 at 20:32

answered Apr 03 '15 at 18:11

user1016274

4,071
1
23
19

I believe so. I don't want to delete the rows that don't have duplicates. I really need to consolidate column J and delete the duplicates so I just have 1 row of the summed values left over. I'm not sure the best way to go about it. – Adiamond Apr 03 '15 at 18:50
The code I posted as answer will indeed work as expected. You only need to increment the active cell's row if you don't delete a duplicate row. The `else` statement is correct. The method is OK as well. May I suggest you declare `Dim i as Long` to avoid problems in (really) huge worksheets? – user1016274 Apr 03 '15 at 19:16
This code may work if comparing the column which ActiveCell belongs to is enough to decide duplication. And this code assumes that the column which is used to comparing is `A` column then using `Range("A1").activate` before the loop also may be a good idea.But there is a `Next`. – kitap mitap Apr 03 '15 at 20:08
Kitap Mitap, thank you for the last comment. My A column is just a date, so if I use that as my comparison it will delete all but 1 row. I am sorting based off Columns B, D and H which is what i need to use to remove duplicates. I've been piddling around with the code but I can't figure it out. My range is A:L. I need to merge duplicate data, but the values in column J need to be summed and I don't really understand the coding enough to be able to tweak it to what i need. – Adiamond Apr 06 '15 at 19:19

kitap mitap · Accepted Answer · 2015-04-08T12:11:38.760

It would have been better to see your table. You still have not explained enough. This answer is not so different from user1016274's answer. The code above first order by the columns B, D and H then checks and deletes the duplicates by the time adding up their J column values, by comparing same columns.

Sub Merge()

    Range("A1").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("D1"), Order2:=xlAscending, _
    Key3:=Range("H1"), Order3:=xlAscending, Header:=xlYes
    'I assume there are column headers. If not, use "Header:=xlNo" instead of "Header:=xlYes"

    Range("A2").Select 'I assume there are column headers. If not, use "Range("A1").Select" instead of "Range("A2").Select"

    Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
        If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 1).Value And ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(1, 3).Value And ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(1, 7).Value Then
            ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(0, 9).Value + ActiveCell.Offset(1, 9).Value
            ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop

End Sub

Excel VBA: Merge Rows and Sum Values

2 Answers2