View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jacob Skaria Jacob Skaria is offline
external usenet poster
 
Posts: 8,520
Default delete duplicate records

Is that only COL A you want to ..Then try the below macro

-With data in Column A (cell A1 should have a header)..run this macro which
will insert a sheet after the current sheet and generate a list of unique
account numbers. Try and feedback

Sub Macro()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ActiveSheet
Set ws2 = Worksheets.Add(After:=ActiveSheet)
ws1.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws2.Range("A1"), Unique:=True
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Krystal Peters" wrote:

Have client request worksheet that has duplicates that must be removed so
clients are not overcharged. The second column (below) indicates the number
of
request received & max # of rows to delete. I have run into a problem when
the max # of rows to delete is more than the records available.

Sample:

ACCT_NO Requests Found
289278995 1
289278999 1
870587008 1
119387014 1
158675527 2
654375649 2
569777245 2
752478468 2
752478468 2
396378512 2
396378512 2
396378512 2
396378512 2
399778090 3
399778090 3
399778090 3
208777882 4
208777882 4
208777882 4
208777882 4
987178737 4
987178737 4
117468837 7
117468837 7
117468837 7
117468837 7

Code used:
sr = currentrow
For counter = 1 To countrows
delrow = ActiveSheet.Cells(sr, 7).Value 'On Paste_Accounts
acct1 = ActiveSheet.Cells(sr, 5).Value 'Acct # 1
acct2 = ActiveSheet.Cells(sr + 1, 5).Value 'Acct #2

If acct1 < acct2 Then
If delrow = 1 Then
ActiveSheet.Cells(sr, 1).Select
Selection.EntireRow.Delete
End If

If delrow 1 Then
r1 = (sr + 1) - delrow
r2 = sr
accts = ActiveSheet.Cells(r1, 5).Value
If accts = acct1 Then
Rows(r1 & ":" & r2).Select
Selection.EntireRow.Delete
sr = r1
Else
Rows(r2).Select
Selection.EntireRow.Delete
End If

End If
Else
sr = sr + 1
End If
Next counter
End Sub

Any help / suggestions would be appreciated.