Alex O
06-12-2012, 02:28 PM
Hello All,
I'm using the code below to search through a range and delete duplicate account numbers for a one month period. Everything works fine. My dataset, however, will soon be changing to include a four year date range. What I'm wondering is, can my code be edited to scan the range by date (the dates are in A:A) and delete duplicates based on account numbers (housed in C:C)? My problem is that many of the same numbers show up month after month. I don't want the code to search the entire range and remove duplicates, but rather month by month. Hopefully this makes sense!
Public Sub DeleteDuplicateRows()
Dim R As Long
Dim N As Long
Dim V As
Variant
Dim Rng As Range
On Error GoTo
EndMacro
Application.ScreenUpdating = False
Application.Calculation =
xlCalculationManual
Set Rng = Application.Intersect(ActiveSheet.UsedRange,
_
ActiveSheet.Columns(ActiveCell.Column))
Application.StatusBar = "Processing
Row: " & Format(Rng.Row, "#,##0")
N = 0
For R = Rng.Rows.Count To 2
Step -1
If R Mod 500 = 0 Then
Application.StatusBar =
"Processing Row: " & Format(R, "#,##0")
End If
V = Rng.Cells(R,
1).Value
If V = vbNullString Then
If
Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1
Then
Rng.Rows(R).EntireRow.Delete
N = N
+ 1
End If
Else
If
Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1
Then
Rng.Rows(R).EntireRow.Delete
N = N
+ 1
End If
End If
Next
R
EndMacro:
Application.StatusBar = False
Application.ScreenUpdating =
True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate
Rows Deleted: " & CStr(N)
End Sub
I'm using the code below to search through a range and delete duplicate account numbers for a one month period. Everything works fine. My dataset, however, will soon be changing to include a four year date range. What I'm wondering is, can my code be edited to scan the range by date (the dates are in A:A) and delete duplicates based on account numbers (housed in C:C)? My problem is that many of the same numbers show up month after month. I don't want the code to search the entire range and remove duplicates, but rather month by month. Hopefully this makes sense!
Public Sub DeleteDuplicateRows()
Dim R As Long
Dim N As Long
Dim V As
Variant
Dim Rng As Range
On Error GoTo
EndMacro
Application.ScreenUpdating = False
Application.Calculation =
xlCalculationManual
Set Rng = Application.Intersect(ActiveSheet.UsedRange,
_
ActiveSheet.Columns(ActiveCell.Column))
Application.StatusBar = "Processing
Row: " & Format(Rng.Row, "#,##0")
N = 0
For R = Rng.Rows.Count To 2
Step -1
If R Mod 500 = 0 Then
Application.StatusBar =
"Processing Row: " & Format(R, "#,##0")
End If
V = Rng.Cells(R,
1).Value
If V = vbNullString Then
If
Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1
Then
Rng.Rows(R).EntireRow.Delete
N = N
+ 1
End If
Else
If
Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1
Then
Rng.Rows(R).EntireRow.Delete
N = N
+ 1
End If
End If
Next
R
EndMacro:
Application.StatusBar = False
Application.ScreenUpdating =
True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate
Rows Deleted: " & CStr(N)
End Sub