Modifying a sub that combines and sums duplicate rows-CodePudding

If this sub finds finds matching values in column A, it will merge those two values into one row, and then sum columns B & C into run row.

I've been trying to change it so that for this to happen, it needs to find a match in columns A & B, then C & D will be summed.

For example:

A  A  5  5 
A  A  5  5
A  B  6  1

Will Become

A  A  10 10
A  B  6  1

Sub Consolidate()
     
   Application.ScreenUpdating = False
        
            Dim s As Worksheet, last_row As Long
            Dim row As Long
            Dim col As Integer, v, m
            
            Set s = Worksheets("Sheet12")
            s.Activate
            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
                v = s.Cells(row, "A").Value
                m = Application.Match(v, s.Columns("A"), 0) 'find first match to this row
                If m < row Then                             'earlier row?
                    'combine rows `row` and `m`
                    s.Cells(m, "B").Value = s.Cells(m, "B").Value   s.Cells(row, "B").Value
                    s.Cells(m, "C").Value = s.Cells(m, "C").Value   s.Cells(row, "C").Value
                    
                    s.rows(row).Delete
                End If 'matched a different row
            Next row
            
End Sub

CodePudding user response：

Slight modification using a dictionary:

Sub Consolidate()
     
    Application.ScreenUpdating = False
        
    Dim s As Worksheet, last_row As Long
    Dim row As Long, dict As Object, k As String, m As Long
    
    Set dict = CreateObject("scripting.dictionary") 'for tracking A B vs first row occurence
    Set s = Worksheets("Sheet12")
    s.Activate
    last_row = s.Cells(s.Rows.Count, 1).End(xlUp).row 'find the last row with data
        
    'map all the A B combinations to the first row they occur on
    For row = 3 To last_row
        k = s.Cells(row, "A").Value & "~~" & s.Cells(row, "B").Value
        If Not dict.exists(k) Then dict.Add k, row
    Next row
        
    For row = last_row To 3 Step -1
        k = s.Cells(row, "A").Value & "~~" & s.Cells(row, "B").Value
        m = dict(k)                                 'find first match to this row from the dictionary
        If m < row Then                             'earlier row?
            'combine rows `row` and `m`
            s.Cells(m, "C").Value = s.Cells(m, "C").Value   s.Cells(row, "C").Value
            s.Cells(m, "D").Value = s.Cells(m, "D").Value   s.Cells(row, "D").Value
            
            s.Rows(row).Delete
        End If 'matched a different row
    Next row
End Sub