Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find duplicates, sum and delete dups
Hey Marcus,
Thanks for the info. Once I did sort the data, the programming worked excellant. That was my original problem, the sorting of the data. Thanks again, -- John "marcus" wrote: Hi John This should do the trick for you. It looks for duplicates in Col A and sums column D, producing just the summary data. It assumes the data in column A is sorted. A pivot table would work just as well. Sub SumandDelete1() Dim myloop As Double Dim myMatched As String Dim SubTtl As Double Dim RowCount As Double Application.ScreenUpdating = False Application.DisplayAlerts = False SubTtl = 0 RowCount = Range("A65536").End(xlUp).Row For myloop = RowCount To 2 Step -1 SubTtl = Cells(myloop, "D") If Cells(myloop, "A") = Cells(myloop - 1, "A") Then SubTtl = SubTtl + Cells(myloop - 1, "D") myMatched = "Y" Rows(myloop).Delete End If If myMatched = "Y" Then Cells(myloop - 1, "D") = SubTtl myMatched = "N" SubTtl = 0 End If Next myloop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Regards Marcus John wrote: I found programming that finds duplicates and sums up the dups but now I need to delete the duplicate records. After running this code, I end up with 709 in row 4 that shows as 250 which is what I want but rows 2 and 3 needs deleted. COL-A COL-B COL-C COL-D 1239 14 COMPUTER HARDWARE 0 1250 10 COURSES - TRAINING 417 1250 12 COURSES - TRAINING 42 1250 14 COURSES - TRAINING 250 1271 10 CUST. DUTY & NON-RECOV 8333 This is what I have: Sub Test() Dim iLastRow As Long Dim i As Long iLastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To iLastRow If Cells(i, "A").Value = Cells(i - 1, "A").Value Then If Cells(i, "A").Value < Cells(i + 1, "A").Value Then Cells(i, "E").Value = Application.SumIf( _ Columns(1), Cells(i, "A").Value, Columns(4)) End If End If Next i End Sub This is what I need to end up with: COL-A COL-B COL-C COL-D 1239 14 COMPUTER HARDWARE 0 1250 14 COURSES - TRAINING 709 1271 10 CUST. DUTY & NON-RECOV 8333 Can someone help to complete this? Thanks, -- John |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find Duplicates Across Two Sheets, Delete Everything else. | Excel Worksheet Functions | |||
Delete Dups | Excel Discussion (Misc queries) | |||
How do I find (not delete) duplicates in multiple spreadsheets? | Excel Worksheet Functions | |||
how do i find and delete duplicates in excel worksheet? | Excel Discussion (Misc queries) | |||
Find & Delete Duplicates across two Excel Worksheets | Excel Programming |