Combine Equal rows (columns C & G) and Sum (columns E & F)

hi rxk. it would be good to upload an excel sample so that we don't have to manually key on our own to test. i have filled up just the essential information and you may try this:

Sub test()

Cells(1, 1).CurrentRegion.Sort key1:=Cells(1, "C"), order1:=xlAscending, key2:=Cells(1, "G"), order2:=xlAscending, Header:=xlYes

LR = Cells(Rows.Count, 1).End(xlUp).Row
For RowX = LR To 2 Step -1
    If Cells(RowX, "C") = Cells(RowX - 1, "C") And Cells(RowX, "G") = Cells(RowX - 1, "G") Then
        If Cells(RowX, "F") <> vbNullString Then
            Cells(RowX - 1, "F") = Cells(RowX - 1, "F") + Cells(RowX, "F")
        Else
            Cells(RowX - 1, "E") = Cells(RowX - 1, "E") + Cells(RowX, "E")
        End If
        Rows(RowX).Delete
    End If
Next

End Sub

Hi,

Here's an other suggestion:
Results will be output to Sheet2 (must exists before running the code)

Sub Test()
   Dim ar, Dic
   Dim i As Integer, j As Integer, n As Integer
   Dim str As String
   
   Set Dic = CreateObject("Scripting.dictionary")
   
   'Store value in aray
   ar = Cells(1).CurrentRegion.Value
   n = 2
   
   For i = 2 To UBound(ar, 1)
      str = ar(i, 3) & ar(i, 7)
   
      If Not Dic.exists(str) Then
         Dic.Add str, n
         For j = 1 To UBound(ar, 2)
            ar(n, j) = ar(i, j)
         Next j
         n = n + 1
      Else
         For j = 1 To UBound(ar, 2)
            Select Case j
            Case 5, 6:
               ar(Dic(str), j) = ar(Dic(str), j) + ar(i, j)
            Case Else:
               ar(Dic(str), j) = ar(i, j)
            End Select
         Next j
      End If
      
   Next i

   'Output results to sheet2 (must exists)
   With Sheets(2)
      .Cells(1).CurrentRegion.Clear
      .Cells(1, 1).Resize(n - 1, UBound(ar, 2)) = ar
   End With

End Sub

So - one row for RX-4231, one row for ZT-4217 and all in between??


*I never clicked - this post has languished for about an hour