Find and Delete Duplicate entries

[Guest]

I have a spreadsheet containing various columns of data

A B C D E F etc.
Agr no. Amount N/A N/A N/A N/A etc.

1 1 etc.
1 3
1 -1
7 2
8 4
8 -4
12 -13
12 13
12 13
12 -13
12 -7
13 2
17 4
18 1

The information in the other columns is not important, but I am looking for
a formula or macro that will automatically search for duplicates
(indefininate number of duplicates) in column A and and sum each 'AGR NO's'
corresponding values in column B and the put it on one line with all the
other information in the other columns also put to one line. The other
information in the other columns is the same for each of the duplicates.
Further if the sum of the duplicates is ZERO then it will just delete all the
information for the duplicates so they are completely removed. The page is up
to 10000 down so takes forever to manually source out duplicates.

The example above would ideally end up looking like,

A B C D E F etc.
Agr no. Amount N/A N/A N/A N/A etc.

1 3
7 2
12 -7
13 2
17 4
18 1

Sorry if this is a bit complex, but if anyone could help that would be
brilliant.

kind regards

Barry Walker

 

[Dave Peterson]

Maybe you could create a pivottable

Select A1:Bxx
Data|pivottable
follow the wizard until you get to a step that has a button named Layout.
Click that Layout button

Drag the "agr no." button to the row field
drag the "amount" button to the data field
if that amount doesn't say "sum of", rightclick on it and choose sum

Finish up the wizard.

Now select all the cells on the sheet
edit|copy
edit|paste special|Values

Apply data|filter|autofilter to column B
Filter to show the 0's
delete those visible rows.
remove the filter from column B

 

[Guest]

How about Subtotals
Select the data click
Data > Subtotals > OK

At each change in : Arg No
Use Function : Sum
Add Sub Totals To : Amount

 

[Dave Peterson]

ps. That technique didn't really remove the duplicates. It just summed all the
values and then you deleted the 0's.

 

[Guest]

Ooops you want to Delete the Duplicate Records.

after doing the sub totals you can view the Subtotals at 2 level (Click on
the 2 which appears on the Top corner of the excel sheet, i.e near Col A)

Select all visible data > Edit > Go to> Special > Click Visible Cells only >
Ctr C (Copy) and paste this in New Sheet.

 

[Guest]

A quick macro:

Writes data to Sheet2 from Sheet1

Sub MergeandDelete()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim irow As Long, orow As Long
Dim Lastrow As Long
Dim n As Integer
Dim nsum As Integer

Set ws1 = Worksheets("Sheet1") '<==Change
Set ws2 = Worksheets("Sheet2") '<== Change


ws1.Activate
With ws1

Lastrow = .Cells(Rows.Count, col).End(xlUp).Row
irow = 2
orow = 1
Rows(1).Copy ws2.Cells(1, 1)
Do
n = Application.CountIf(Range("A:A"), Cells(irow, 1))
nsum = Application.Sum(Range("B" & irow & ":B" & irow + n - 1))
If nsum <> 0 Then
orow = orow + 1
Rows(irow).Copy ws2.Cells(orow, 1)
ws2.Cells(orow, 2) = nsum
End If
irow = irow + n
Loop Until irow > Lastrow

End With

 

[Guest]

Here's a macro I use:

Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Guest]

Another play which achieves it, using non-array formulas in a new sheet ..

Assume source data as posted is in a sheet: X, cols A to E (say)
where the key col A = Agr no. and col B = Amount
Data is assumed running in row2 down

In a new sheet, place

In A2:
=IF(X!A2="","",IF(COUNTIF(X!A$2:A2,X!A2)>1,"",ROW()))
Leave A1 blank

In B2:
=INDEX(X!A:A,SMALL($A:$A,ROWS($1:1)))

In C2:
=SUMIF(X!A:A,B2,X!B:B)

In D2:
=IF(C2=0,"",ROW())
Leave D1 blank

In E2:
=IF(ROWS($1:1)>COUNT($D:$D),"",INDEX(B:B,SMALL($D:$D,ROWS($1:1))))
Copy E2 to F2

In G2:
=IF($E2="","",INDEX(X!C:C,MATCH($E2,X!$A:$A,0)))
Copy G2 across to I2

Select A2:I2, copy down to cover the max expected extent of source data in
X, eg down to I10000?. Hide away cols A to D. Cols E to I should return
exactly what you want, with all result lines neatly bunced at the top.

 

[Guest]

Looks interesting but the macro says,

compile error: expected end sub

thanks for your help guys! I hope on eof these things work

 

[Guest]

soory copy error ... just add

End Sub

Sub MergeandDelete()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim irow As Long, orow As Long
Dim Lastrow As Long
Dim n As Integer
Dim nsum As Integer

Set ws1 = Worksheets("Sheet3")
Set ws2 = Worksheets("Sheet1")


ws1.Activate
With ws1

Lastrow = .Cells(Rows.Count, col).End(xlUp).Row
irow = 2
orow = 1
Rows(1).Copy ws2.Cells(1, 1)
Do
n = Application.CountIf(Range("A:A"), Cells(irow, 1))
nsum = Application.Sum(Range("B" & irow & ":B" & irow + n - 1))
If nsum <> 0 Then
orow = orow + 1
Rows(irow).Copy ws2.Cells(orow, 1)
ws2.Cells(orow, 2) = nsum
End If
irow = irow + n
Loop Until irow > Lastrow

End With


End Sub

 

[Guest]

Try this:
"rng1" and "rng2" are define name ranges in column A and column B

In A20:
=IF(ISERR(SMALL(IF(FREQUENCY(MATCH(rng1&"",rng1&"",0),MATCH(rng1&"",rng1&"",0))>0,ROW(INDIRECT("1:"&ROWS(rng1)))),ROWS($1:1))),"",INDEX(rng1,SMALL(IF(FREQUENCY(MATCH(rng1&"",rng1&"",0),MATCH(rng1&"",rng1&"",0))>0,ROW(INDIRECT("1:"&ROWS(rng1)))),ROWS($1:1))))

ctrl+shift+enter, not just enter
copy down

In B20: =IF(A20="","",SUMIF(rng1,A20,rng2))
copy down