Excel VBA on combining multiple formulas [duplicate] - vba

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

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

Answer 2

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"