VBA helps needed to Sum duplicate values and delete duplicate rows

**krjoshi** · 02-03-2013, 02:56 PM

Hi Folks,

I have two sheets in my Workbook, one for user input “SAP_INPUT” second one for the summary report. I need a Macro to do the sum of the duplicate row records, delete duplicated rows and do some calculation.

My small example workbook can describe better.

Thanks in advance for your expertise!

Joshi

**jindon** · 02-03-2013, 06:07 PM

try

Sub test()
    Dim a, i As Long, ii As Long, n As Long, e
    a = Sheets("sap_input").Cells(1).CurrentRegion.Resize(, 14).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 5)) Then
                n = n + 1: .Item(a(i, 5)) = n
                For ii = 1 To UBound(a, 2)
                    a(n, ii) = a(i, ii)
                Next
            Else
                For Each e In Array(10, 14)
                    a(.Item(a(i, 5)), e) = _
                    a(.Item(a(i, 5)), e) + a(i, e)
                Next
                For ii = 12 To 13
                    a(.Item(a(i, 5)), ii) = _
                    Application.Max(a(.Item(a(i, 5)), ii), a(i, ii))
                Next
            End If
        Next
    End With
    With Sheets("after_macro_runs").Cells(1).Resize(n, 14)
        .CurrentRegion.ClearContents
        .Value = a
        With .Columns(.Columns.Count + 2)
            .Cells(1).Value = "CONCERN"
            .Offset(1).Resize(n - 1).Formula = _
            "=if(j2-(l2+m2)-n2<0,""No Consern"",j2-(l2+m2)-n2)"
            .Columns.AutoFit
        End With
        .Columns.AutoFit
    End With
End Sub

**krjoshi** · 02-03-2013, 11:00 PM

Hi Jindon,
Thank you so much, your code working like charm. I need so two more addition on that, now I have to split the "CONCERN" and "NO CONCERN" into two separate sheets (if the sheets are existing, then delete and create new sheets) and the last column formula to be replaced with values.

Thanks in advance for your time.

Thanks,
Joshi