I've been trying to re-work this code I found to combine and sum rows in a sheet.

I have a sheet with values in columns columns A-G. And a Dynamic number of rows.

If an exact duplicate is found in column D, I want to add (sum) the "column G" and "column H" values from the duplicate row, with the "G" and "H" values from the original row. With the result being in the original row.

For all other columns, I want the duplicate row to overwrite the original. (Or, overwrite if the exact same, and place next to the original value in the same cell if different, but this is beyond my knowledge.)

To clarify, the code will loop through column 'D' until it finds duplicate values. It will then delete the row of this duplicate value, after copying/pasting its values over those of the original. Except for "G" and "H", where it will sum its values with the original rows "G" and "h".

ie.

Would turn into

In place of the original, for all duplicate (column "D") rows in the worksheet.

Thanks for any input.

This code I've been trying to change: works for 4 columns where column A is the ID as opposed to column D, and doesn't include the sum condition. I'm having trouble fitting it to my conditions. Specifically, why is the Cl range 'B' when this range isn't consequential, and what format the offset follows.

Sub mergeRows()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Comparemode = vbTextCompare
    Dim Cl As Range, x$, y$, i&, Key As Variant
    For Each Cl In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
        x = Cl.Value & "|" & Cl.Offset(, 1).Value
        y = Cl.Offset(, 2).Value
        If Not Dic.exists(x) Then
            Dic.Add x, Cl.Offset(, -1).Value & "|" & y & "|"
        ElseIf Dic.exists(x) And Not LCase(Dic(x)) Like "*|" & LCase(y) & "|*" Then
            Dic(x) = Dic(x) & "|" & y & "|"
        End If
    Next Cl
    Range("A2:D" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    i = 2
    For Each Key In Dic
        Cells(i, "A") = Split(Dic(Key), "|")(0)
        Range(Cells(i, "B"), Cells(i, "C")) = Split(Key, "|")
        Cells(i, "D") = Replace(Split(Replace(Dic(Key), "||", ";"), "|")(1), ":", ";")
        i = i   1
    Next Key
    Set Dic = Nothing
End Sub

CodePudding user response：

The example you are trying to copy seems overly complex and relies on objects only available on the Windows platform. I started from scratch to meet your needs with simpler code--I hope you are able to follow it and adjust as needed.

It combines data in this sheet:

into this:

Sub merge_rows()
    Dim last_row As Long
    Dim row As Long
    Dim s As Worksheet
    Dim col As Integer
    
    Set s = ActiveSheet 'use this line to process the active sheet
    'set s = thisworkbook.Worksheets("Sheet1") ' use this line to process a specific sheet
    
    last_row = s.Cells(s.Rows.Count, 1).End(xlUp).row 'find the last row with data
    
    For row = last_row To 3 Step -1
        If s.Cells(row, "D").Value = s.Cells(row - 1, "D").Value Then
            ' found a match in column d
            
            ' add column G
            s.Cells(row - 1, "G").Value = s.Cells(row - 1, "G").Value   s.Cells(row, "G").Value
            
            ' add column H
            s.Cells(row - 1, "H").Value = s.Cells(row - 1, "H").Value   s.Cells(row, "H").Value
            
            'append all other columns if different
            For col = 1 To 6
                If Not s.Cells(row, col).Value = s.Cells(row - 1, col).Value Then
                  s.Cells(row - 1, col).Value = s.Cells(row - 1, col).Value & " " & s.Cells(row, col).Value
                End If
            Next
            
            ' now delete the duplicate row
            s.Rows(row).Delete
        End If
    Next

End Sub