for every cell search identical in range, not whole column; how?
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" skrev i meddelelsen
...
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
|