K
Krystal Peters
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.
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.