I had in mind something like -

Option Explicit

Sub Testit()
Dim rng As Range
Dim nLastrow As Long

MakeDups

nLastrow = Range("A2").End(xlDown).Row
Set rng = Range(Cells(1, 1), Cells(nLastrow, 1))

DelDupRows rng, nLastrow

End Sub

Sub DelDupRows(rData As Range, lLast As Long)
Dim bTopRow
Dim nCol As Long
Dim sFmla As String
Dim nFcnt As Long
Dim rTmp As Range
Dim ws As Worksheet

Set ws = rData.Parent

'assumes rData does NOT start in row 1

With ws.UsedRange
nCol = .Columns.Count + .Columns(1).Column
End With

' above better than (imo)
' nCol = ws.Cells.SpecialCells(xlCellTypeLastCell).Column + 1

If nCol ws.Columns.Count Then
' bit more work to do
' must be an empty column somwhere ???
End If

With rData(1)
'somthing like =COUNTIF($A$2:A2,A2)1
sFmla = "=COUNTIF(" & .Address & ":" & .Address(0, 0) _
& "," & .Address(0, 0) & ")1"
Set rTmp = ws.Cells(.Row, nCol)
bTopRow = (.Rows(1).Row = 1)
End With

rTmp.Formula = sFmla
rTmp.AutoFill Destination:=Range(rTmp, ws.Cells(lLast, nCol))

If Application.Calculation < xlCalculationAutomatic Then
ws.Calculate
End If

If bTopRow Then
Rows("1:1").Insert
End If

rTmp.Offset(-1, 0) = "abc"

On Error Resume Next
Do While nFcnt = 0
rTmp.Offset(-1, 0).AutoFilter
nFcnt = ws.AutoFilter.Filters.Count
Loop

rTmp.Offset(-1, 0).AutoFilter Field:=nFcnt, Criteria1:="TRUE"

rData.EntireRow.Delete
rTmp.AutoFilter
rTmp.Columns(1).EntireColumn.Delete

If bTopRow Then
Rows("1:1").EntireRow.Delete
End If
End Sub

Sub MakeDups()
Dim nRows As Long, i As Long

'Columns("A:A").ClearContents

nRows = 1000
ReDim arr(1 To nRows, 1 To 1)

For i = 1 To nRows
arr(i, 1) = "Hello " & Format(Int((100) * Rnd), "00")
Next
Range("a2:a" & nRows).Value = arr

End Sub

Regards,
Peter T

"Peter T" <peter_t@discussions wrote in message
...
Hi Bart,

Have you thought of adding a helper column with formula (this assumes
looking for duplicates in A2 down) -

=COUNTIF($A$2:A2,A2)1

Use "autofill" to copy down to the last row
Add an Auto filter top of this column, filter True and delete entire rows
of
the filter range.
Could use the hidden sheet name "_Filterdatabase" (starting one row down
from the top if necessary).

Regards,
Peter T

"RB Smissaert" wrote in message
...
Jim,

A bit neater again, but maybe it has to be done the messy way as I
noticed
objects in the sheet are lost.
Although it is a lot more code, maybe there are advantages to do this
without the filter altogether.
So get the range in an array, filter the unique rows in the array and
put
it
back.
The one advantage I can see is that you do it case sensitive and case
in-sensitive.
The drawback would be it that if the range is large it might get a bit
slow.

RBS



"Jim Cone" wrote in message
...
RBS,

I did play around with using only the original sheet.
However, it involved...
Using SpecialCells to get the visible range.
Looping thru each range area and writing each cell value to an
array.
Placing the array on the sheet.
It wasn't very neat.

The following is an amended version of my earlier post that
is a little more compact...
Regards,
Jim Cone
San Francisco, USA

'---------------------------
Sub test()
FilterUniqueInRange ActiveSheet, ActiveWindow.RangeSelection
End Sub
'---
Sub FilterUniqueInRange(sh As Worksheet, rng As Range)
Dim strName As String
Dim shtTemp

strName = sh.Name
Set shtTemp = _
ActiveWorkbook.Sheets.Add(after:=Worksheets(strNam e), Count:=1)
sh.Activate
rng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=shtTemp.Range(rng(1).Address), Unique:=True

Application.DisplayAlerts = False
sh.Delete
shtTemp.Name = strName
Application.DisplayAlerts = True
Set shtTemp = Nothing
End Sub
'---------------------------


"RB Smissaert"

wrote in message

Jim,
Yes, that is a bit neater indeed.
I was hoping though that there might be a way to do away
with the temp worksheet, although it is not really a problem.
RBS