PDA

View Full Version : [SOLVED] Summing of multiple totals.



rdelosh74
07-21-2014, 07:39 AM
Need some help on this please.

Column A has part numbers in it. Could be numbers or letters or a mixture. I need to find all duplicates. And SUM the totals in column H, I and J (separately) if there is a duplicate for that row.
And then to delete the entire row that had the duplicate information. Leaving just the first instance of the part number.

I have enclosed a sample to show what I mean.

This needs to be set up to always run on the last sheet of the workbook.

There could be no duplicates for a row, or up to 50 plus duplicates.

In the sample file. I have two tabs, Before and After. Before the macro is run, and after the macro is run. The after is just for example and I do not need another sheet added.

Thank you very much.

11996

Bob Phillips
07-22-2014, 01:41 AM
Public Sub Reformat()
Dim rng As Range
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("K3:M3").Value = Array("In game", "On cart", "tmp")
.Range("K4").Resize(lastrow - 3, 2).Formula = "=IF(SUMIF($A$4:$A$45,$A4,I$4:I$45)=0,"""",SUMIF($A$4:$A$45,$A4,I$4:I$45))"
.Range("M4").Resize(lastrow - 3).Formula = "=COUNTIF($A$3:$A3,$A4)>0"
.Range("I3").Resize(lastrow - 2).Copy
.Range("K3").Resize(lastrow - 2, 2).PasteSpecial Paste:=xlPasteFormats
With .Range("K3").Resize(lastrow - 2, 2)

.Value = .Value
End With
Set rng = .Range("M3").Resize(lastrow - 2)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible).Areas(2)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
.Columns("M").Delete
.Columns("I:J").Delete
End With
End Sub

rdelosh74
07-24-2014, 07:19 AM
Perfect!

Thank you very much.