for every cell search identical in range, not whole column; how?

[ppeer]

Hi expert,

To delete identical entries in cells of the first column (and delete
that row), I use a code which searches the whole column everytime. I
would like to speed things up.

If I sort on the second column (area code), the first column (postal
code) can be divided in multiple ranges:
A duplicate cell value, only occurs within the same range (area code)
as the reference cell value (e.g. a postal code/identical postal codes
only refer to one area code).


How should I adjust the following code to search part of the first
column (sorted on area code, second column) for duplicate postal
codes, instead of the whole column. I expect this to speed things up
significantly.

regards
ppeer

Sub DuplicateIDCorrection()
'Adjust next constant to your own needs
Const myColumn As String = "A"
Dim a, lngLastRow, T, RR As Long
Dim rng As Range
Dim cell As Range
Dim Found As Range
Dim blnFound As Boolean


lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).row
Set rng = Range(myColumn & "1:" & myColumn & lngLastRow)
rng.Interior.ColorIndex = xlNone


T = 0

For Each cell In rng
If cell.Text <> "" And IsError(cell.Value) <> True Then
Set Found = rng.Find(cell.Value, LookAt:=xlWhole)
If Not Found Is Nothing Then

If Found.Address <> cell.Address Then

RR = cell.row
T = T + 1
Debug.Print Found.Value, Found.Address,
cell.Address, T, RR, a
Rows(RR).Delete

End If
End If
End If
Next
Next a

'If blnFound = True Then MsgBox "Duplicates Found"


End Sub

 

[Per Jessen]

Hi

Try to turn off calculation and screenupdating, I think it will speed your
macro more up than what you want to do:

Insert theese statements after the Dim statements:

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

And to turn them on again, insert this before End Sub:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Regards,
Per

 

[ppeer]

thanks Per