VBA to filter a column starting at row 2 to Lastrow

[simora]

I am trying to get only Unique values in Column A starting at Row 2.
When I use this process, it gives me the first entry 2 times in the copied data in Column CN2.

Range("A2:A2" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CN2"), Unique:=True
    r = Cells(Rows.count, "CN").End(xlUp).Row

I have tried multiple incarnations of Range("A2:A" etc... etc...
If I modify it to use the first row, it works OK, but I dont want to have the headings captured.

How do I modify this while only capturing the actual Unique values in Column A but not any shapes that may be in Col A1 or A2

[p45cal]

try:

Set mySht = ActiveSheet
With Sheets.Add
  mySht.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
  .UsedRange.Resize(.UsedRange.Rows.Count - 1).Offset(1).Copy mySht.Range("CN2")
  Application.DisplayAlerts = False
  .Delete
  Application.DisplayAlerts = True
End With

[mperrah]

maybe this, in "A2:A2" the second 2 is intended to be the LastRow.. so omit the second 2

Range("A2:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CN2"), Unique:=True 
r = Cells(Rows.count, "CN").End(xlUp).Row

[simora]

Hi p45cal:

I tried the code and I get the same results as when I simply use Range("A1:A" & LastRow). with my Advanced Filter.
I get the first Value twice. I'm not sure why this is happening, and I've tried various incarnations of the filter.
Your idea of using UsedRange & Resize just gave me some ideas to try.

Thanks for the responce & the effort.

[simora]

mperrah :

Thanks; but I had already tried that and it copies the first value in Col A1 twice.
I just tried it again just to make sure.

[simora]

I'm thinking that this has to be a BUG. I just created a blank worksheet with some numbers & text and tried to filter it MANUALLY on the page using the Advanced Filter.
It grabs the first value twice. Just like the code is doing.
I just created a workaround in the finished formatting to take care of the problem.

[p45cal]

Hi I tried the code and I get the same results as when I simply use Range("A1:A" & LastRow). with my Advanced Filter.
I get the first Value twice.

Advanced Filter needs a header I think, and it's this that you're seeing as a duplicate value.
So I included the header (presumed to be in A1) and put the filter results on a brand new (temporary) sheet - this sheet has the header. I then copied everything but the first row (the header) from this brand new sheet to your destination, then deleted the temporary sheet.
(I was able to duplicate your duplicate value by the way before coming up with this solution.)

Could you supply a simple workbook where you've attempted to use my solution but you're still getting duplicates so that I can see what's going on?

[simora]

Thanks p45cal :

I think your Workaround would work. This is mine.

Since Its getting the Header anyway, I just tested for it & since its offset value will always be 0, I handled it this way.
If it sees a duplicate, it just deletes one of them.

Range("CO2").Select     ' First row after the Header
    
    If ActiveCell.Value = 0 Then
        ActiveCell.ClearContents
        Range("CN2").Value = ""      ' The row to the left
        Range("CN2").ClearFormats
            If Range("CN2").Value = Range("CN3").Value Then      ' Checks for duplicates & handles it
                Range("CN2").Value = ""
                Range("CO2").Value = ""
            End If
            
    End If

[simora]

When I use Range("A1:A" & LastRow). etc.. etc... I match these Unique values with values from another column.
The value matching Column A1, the Header, will always be 0, that's why my workaround works everytime.
I don't like adding extra worksheets unless absolutely necessary.

Thanks for all the ideas and suggestions.

[apo]

Maybe try using a Dictionary.. Loop though your values.. adding them to the Dictionary.. then.. the Unique values will be the Keys..

[snb]

If you dive into advanced filter it's obvious it needs & assumes a header row.
What you consider to be a 'bug' is in fact an assumption/prerequisite.
If you need the unique values without the 'fieldname' use:

Sub M_snb()
    Columns(1).SpecialCells(2).AdvancedFilter 2, , Cells(1, 14), True
    sn = Columns(14).SpecialCells(2).Offset(1).SpecialCells(2)
End Sub

[simora]

snb:

I just tried your code and it still DOES grab the header line.
An Interesting idea nethertheless.
How can I utilize Offset & Resize into this code. I tried that in multiple ways and always get an error.
Thanks

[snb]

That's exactly what I said: the header is a prerequisite.
All the values (header excluded) are being stored in the array variable sn

for j=1 to ubound(sn)
  msgbox sn(j,1)
Next

[p45cal]

note, that for
Columns(1).SpecialCells(2).AdvancedFilter 2, , Cells(1, 14), True
to work well there must be no blank cells among the data in column 1

[simora]

p45cal Thanks for the observation.

snb Got your point. Thanks


Any ideas as to if its possible to capture the values only & omit any shapes that may be in the filtered range ?

[mperrah]

how about the remove duplicates in the menu under data
copy the full column to a blank range and run this
note: this is avoiding the header

 lr = Cells(Rows.Count, 1).End(xlUp).Row
        
    Range("A2:A" & lr).Copy Destination:=Range("ZZ1")
    ActiveSheet.Range("$ZZ$1:$ZZ" & lr).RemoveDuplicates Columns:=1, Header:=xlNo

then you can re-insert the data as needed

[p45cal]

omitting shapes:
Add one line to my offering:

Set mySht = ActiveSheet
With Sheets.Add
    mySht.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
    .DrawingObjects.Delete 'depends if they're all drawing object shapes.
    .UsedRange.Resize(.UsedRange.Rows.Count - 1).Offset(1).Copy mySht.Range("CN2")
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End With

as the comment indicates, this may not do it for you depending on the types of shape present, so have a look at http://www.rondebruin.nl/win/s4/win002.htm

[simora]

Hi:
Did NOT see these posts alerts in my email.
mperrah : Interesting idea! Thanks.


Thanks p45cal : I wasn't sure that the filter could be modified i.e Like
.DrawingObjects.Delete

This is kind of what I did. On some systems, you may have to select before deleting the shape.

ActiveSheet.Range("CM1").Select
For Each oShape In ActiveSheet.Shapes  
    If Not Application.Intersect(oShape.TopLeftCell, ActiveSheet.Range("CM1:CO2")) Is Nothing Then
        oShape.Select
        oShape.Delete
   End If
Next