Trying to make some code that filters the unique rows in a range, but only
leaves the visible row, making it just as a normal range. So, no blue row
numbers and continuous row numbering without gaps.
Something like this will do it, but I think there must be a shorter more
elegant way:

Sub test()
FilterUniqueInRange ActiveSheet, ActiveWindow.RangeSelection
End Sub


Sub FilterUniqueInRange(sh As Worksheet, rng As Range)

Dim arr
Dim shTemp

sh.Activate
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveWindow.RangeSelection.Copy

Set shTemp =
ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksh eets.Count))
shTemp.Name = "tempPaste"
shTemp.Activate
ActiveSheet.Paste
Application.CutCopyMode = False

With sh
.ShowAllData
.Cells.Clear
End With

ActiveWindow.RangeSelection.Copy

sh.Activate
Cells(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Application.DisplayAlerts = False
shTemp.Delete
Application.DisplayAlerts = True

End Sub


RBS

RBS,

Since you are clearing all the cells on the original sheet why not...
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 shTemp

sh.Activate
strName = sh.Name
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveWindow.RangeSelection.Copy

Set shTemp = _
ActiveWorkbook.Sheets.Add(after:=Worksheets(strNam e))
shTemp.Paste
Application.CutCopyMode = False


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


"RB Smissaert"

wrote in message

Trying to make some code that filters the unique rows in a range, but only
leaves the visible row, making it just as a normal range. So, no blue row
numbers and continuous row numbering without gaps.
Something like this will do it, but I think there must be a shorter more
elegant way:
Sub test()
FilterUniqueInRange ActiveSheet, ActiveWindow.RangeSelection
End Sub

Sub FilterUniqueInRange(sh As Worksheet, rng As Range)
Dim arr
Dim shTemp

sh.Activate
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveWindow.RangeSelection.Copy

Set shTemp =
ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksh eets.Count))
shTemp.Name = "tempPaste"
shTemp.Activate
ActiveSheet.Paste
Application.CutCopyMode = False

With sh
.ShowAllData
.Cells.Clear
End With

ActiveWindow.RangeSelection.Copy

sh.Activate
Cells(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Application.DisplayAlerts = False
shTemp.Delete
Application.DisplayAlerts = True
End Sub
RBS

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


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

Since you are clearing all the cells on the original sheet why not...
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 shTemp

sh.Activate
strName = sh.Name
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveWindow.RangeSelection.Copy

Set shTemp = _
ActiveWorkbook.Sheets.Add(after:=Worksheets(strNam e))
shTemp.Paste
Application.CutCopyMode = False


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


"RB Smissaert"

wrote in message

Trying to make some code that filters the unique rows in a range, but only
leaves the visible row, making it just as a normal range. So, no blue row
numbers and continuous row numbering without gaps.
Something like this will do it, but I think there must be a shorter more
elegant way:
Sub test()
FilterUniqueInRange ActiveSheet, ActiveWindow.RangeSelection
End Sub

Sub FilterUniqueInRange(sh As Worksheet, rng As Range)
Dim arr
Dim shTemp

sh.Activate
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveWindow.RangeSelection.Copy

Set shTemp =
ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksh eets.Count))
shTemp.Name = "tempPaste"
shTemp.Activate
ActiveSheet.Paste
Application.CutCopyMode = False

With sh
.ShowAllData
.Cells.Clear
End With

ActiveWindow.RangeSelection.Copy

sh.Activate
Cells(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Application.DisplayAlerts = False
shTemp.Delete
Application.DisplayAlerts = True
End Sub
RBS

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

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

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