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.
|