Appreciate that.

Here we dont have much information. There can be better/faster solutions but
again that depends on the requirements. If we are talking about getting into
a unique list out of ColA; try the below..

Sub DeleteRows()
Dim lngLastRow As Long
lngLastRow = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, SearchOrder:=xlRows).Row
Range("A1:A" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A" & lngLastRow + 1), Unique:=True
Rows("1:" & lngLastRow).Delete
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"Scossa" wrote:

On 1 Ott, 13:41, Jacob Skaria
wrote:
Try setting Calculation to manual and disabling Alerts & Screen updating to
see 49.5 coming down..

Times (244.9 49.5 and 25.3) measured with this
3 sub modified and used for test:


Sub DeleteRows()
'by Jacob Skaria

Dim nStart As Double
Dim lngRow As Long
Dim nCol As Long
Dim xlcalc As XlCalculation

With Application
xlcalc = .Calculation
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.StatusBar = "working ... "
End With
nCol = Selection.Column
nStart = Timer
For lngRow = Cells(Rows.Count, nCol).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Columns(nCol), Cells(lngRow,
nCol)) _
1 Then Rows(lngRow).Delete
Next
MsgBox "elapsed time: " & Timer - nStart
Application.StatusBar = False

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlcalc
.StatusBar = False
End With

End Sub

Sub dups()
' by JLGWhiz

Dim lr As Long, i As Long, sh As Worksheet
Dim nCol As Long
Dim nStart As Double
Dim xlcalc As XlCalculation

With Application
xlcalc = .Calculation
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.StatusBar = "working ... "
End With

Set sh = ActiveSheet
nCol = Selection.Column
lr = sh.Cells(Rows.Count, nCol).End(xlUp).Row

nStart = Timer
For i = lr To 2 Step -1
If sh.Cells(i, nCol) = sh.Cells(i - 1, nCol) Then
Rows(i).Delete
End If
Next
MsgBox "elapsed time: " & Timer - nStart
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlcalc
.StatusBar = False
End With
Set sh = Nothing
End Sub

Sub DelRow()
' by Scossa

Dim rRng As Range
Dim rCella As Range
Dim nCnt1 As Long
Dim nCol As Long
Dim nCnt2 As Long
Dim nLastR As Long
Dim nStart As Double
Dim xlcalc As XlCalculation


With Application
xlcalc = .Calculation
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.StatusBar = "working ... "
End With

nCol = Selection.Column
nLastR = Cells(Rows.Count, nCol).End(xlUp).Row
Set rRng = ActiveCell.Resize(nLastR, 1)

With rRng
nLastR = .Rows.Count
nCnt2 = 0
Set rCella = .Cells(nLastR, 1)
nStart = Timer
For nCnt1 = nLastR To 2 Step -1

If .Cells(nCnt1, 1) = .Cells(nCnt1 - 1, 1) Then
nCnt2 = nCnt2 + 1
Set rCella = rCella.Offset(-1, 0)
Else
With rCella
If nCnt2 0 Then
.Offset(1, 0).Resize(nCnt2).EntireRow.Delete
' Application.StatusBar = "elaborating cells ...
remaining " _
' & nCnt1
End If
End With
nCnt2 = 0
Set rCella = .Cells(nCnt1 - 1, 1)
End If
Next nCnt1
MsgBox "elapsed time: " & Timer - nStart
End With
rRng.Cells(1, 1).Select
Application.ActiveWindow.ScrollRow = 1
Set rRng = Nothing
Set rCella = Nothing

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlcalc
.StatusBar = False
End With

End Sub


Only for information, not for to polemize.

Bye!
Scossa