CODEWITHSUNDEEP
vbaexcel
Aderon
Aderon

Reputation: 43

VBA- Search for duplicates and sum them

I have the following sheet as an example: Example of how the sheet can look I need a language that searches the entire A column and when it finds duplicates of the same account such as 167, it sums all the account values (from D and E) with the same account number in column F (for Column D) and G (for Column E). It would be great if the sum could be found in the last cell of the last account from the duplicates. In the case of 167 that would mean F/G10.

P.S. If i were to also delete the previous rows after summing them (keeping only the last one with the sum), how could i do that?

Thank you! Great answers!

Upvotes: 0

Views: 181

Answers (2)

user3598756
user3598756

Reputation: 29421

alternative VBA solutions

with formulas

Sub Test_KeepFormulas()    
ThisWorkbook.ActiveSheet.Columns("A").SpecialCells(xlCellTypeConstants, xlNumbers).Offset(, 5).Resize(, 2).FormulaR1C1 = "=IF(COUNTIF(R[+1]C1:R20C1, RC1)>0,"""",SUMIF(C1,RC1,C[-2]))"    
End Sub

with values

Sub Test_KeepValues()    
With ThisWorkbook.ActiveSheet.Columns("A").SpecialCells(xlCellTypeConstants, xlNumbers).Offset(, 5).Resize(, 2)
    .FormulaR1C1 = "=IF(COUNTIF(R[+1]C1:R20C1, RC1)>0,"""",SUMIF(C1,RC1,C[-2]))"
    .Value = .Value
End With
End Sub

Upvotes: 0

TheGuyThatDoesn'tKnowMuch
TheGuyThatDoesn'tKnowMuch

Reputation: 1250

For a formula solution:

Put this in Cell F2 and fill down:

=IF(COUNTIF(A3:$A$17,A2)>0,"",SUMIF(A:A,A2,D:D))

Put this in Cell G2 and fill down:

=IF(COUNTIF(A3:$A$17,A2)>0,"",SUMIF(A:A,A2,E:E))

Assuming your dataset goes past the screenshot you will need to change $A$17 in the COUNTIF to match the row after the last row of data.

For a VBA solution:

This will do the calculations for you and only populate the values of the results:

Sub test()

Dim i As Integer
Dim lRow As Integer
Dim j As String

lRow = Cells(Rows.Count, "A").End(xlUp).Row

With ThisWorkbook.ActiveSheet

For i = 2 To lRow

j = .Evaluate("=IF(COUNTIF(A" & i + 1 & ":$A$" & lRow + 1 & ",A" & i & ")>0,"""",SUMIF(A:A,A" & i & ",D:D))")

.Cells(i, 6).Value = j

Next i

For i = 2 To lRow

j = .Evaluate("=IF(COUNTIF(A" & i + 1 & ":$A$" & lRow + 1 & ",A" & i & ")>0,"""",SUMIF(A:A,A" & i & ",E:E))")

.Cells(i, 7).Value = j

Next i

End With

End Sub

This will paste the formulas in their respective cells, but will keep the formulas there:

Sub test()

Dim i As Integer
Dim lRow As Integer

lRow = Cells(Rows.Count, "A").End(xlUp).Row

With ThisWorkbook.ActiveSheet

For i = 2 To lRow

.Cells(i, 6).Value = "=IF(COUNTIF(A" & i + 1 & ":$A$" & lRow + 1 & ",A" & i & ")>0,"""",SUMIF(A:A,A" & i & ",D:D))"

Next i

For i = 2 To lRow

.Cells(i, 7).Value = "=IF(COUNTIF(A" & i + 1 & ":$A$" & lRow + 1 & ",A" & i & ")>0,"""",SUMIF(A:A,A" & i & ",E:E))"

Next i

End With

End Sub

Upvotes: 1

Related Questions