how to combine duplicate rows and sum the values 3

Question

Hello everyone, I have a problem to create VBA excel to duplicate data.

How to combine duplicate rows and sum the values 3 column in excel?

Thank you.

Answer 1

edited after OP's clarifications

try this

solution maintaining original data:

Option Explicit

Sub main()

With Worksheets("Sheet01") '<== change "Sheet01" as per your actual sheet name

    With .Range("A1:C1").Resize(.Cells(.rows.Count, 1).End(xlUp).Row)
        .Copy
        With .Offset(, .Columns.Count + 1)
            .PasteSpecial xlPasteAll ' copy value and formats
            .Columns(2).Offset(1).Resize(.rows.Count - 1, 2).FormulaR1C1 = "=SUMIF(C1,RC1,C[-" & .Columns.Count + 1 & "])"
            .Value = .Value
            .RemoveDuplicates 1, xlYes
        End With
    End With

End With
End Sub

solution overwriting original data (kept for reference):

Sub main()
Dim helperRng As Range, dataRng As Range
Dim colToFilter As String
Dim colsToSumUp As Long

With Worksheets("Sheet01") '<== change "Sheet01" as per your actual sheet name
    Set dataRng = .Range("A2:C2").Resize(.Cells(.rows.Count, 1).End(xlUp).Row - 1)
    colToFilter = "A" ' set here the column header you want to sum up on
    colsToSumUp = 3 ' number of adjacent columns to sum up with
    Set helperRng = dataRng.Offset(, .UsedRange.Columns.Count + 1).Resize(, 1) 'localize "helper" cells first column out of sheet used range
    With helperRng
        .FormulaR1C1 = "=RC" & Cells(1, colToFilter).Column 'make a copy of the values you want to sum up on
        .Offset(, 1).FormulaR1C1 = "=if(countif(R1C[-1]:RC[-1], RC[-1])=1,1,"""")" 'localize with "1" first occurrence of each unique value
        With .Offset(, 2).Resize(, colsToSumUp)
            .FormulaR1C1 = "=sumif(C" & helperRng.Column & ", RC" & helperRng.Column & ",C[" & Cells(1, colToFilter).Column - helperRng.Column - 1 & "])" 'sum up in adjacent columns
            .Value = .Value 'get rid of formulas
        End With
        .Offset(, 1).SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Delete 'delete rows with repeted values you want to sum up on
        dataRng.Columns(2).Resize(.rows.Count, colsToSumUp).Value = .Offset(, 2).Resize(.rows.Count, colsToSumUp).Value 'copy summed up values from "helper" cells
        helperRng.Resize(, 1 + 1 + colsToSumUp).Clear 'clear "helper" cells
    End With

End With

End Sub

it's commented so that you can follow the code and adapt to your actual data "structure"

Answer 2

this one uses Remove Duplicates:

Sub dupremove()
Dim ws As Worksheet
Dim lastrow As Long

Set ws = Sheets("Sheet1") ' Change to your sheet

With ws
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    With .Range("B2:C" & lastrow)
        .Offset(, 4).FormulaR1C1 = "=SUMIF(C1,RC1,C[-4])"
        .Offset(, 4).Value = .Offset(, 4).Value
    End With
    With .Range("A1:A" & lastrow)
        .Offset(, 4).Value.Value = .Value
    End with
    .Range("E1:G" & lastrow).RemoveDuplicates 1, xlYes

End With

End Sub