PDA

View Full Version : [SOLVED] VBA to filter a column starting at row 2 to Lastrow



simora
05-08-2015, 02:47 PM
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
05-08-2015, 03:28 PM
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
05-08-2015, 03:52 PM
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
05-08-2015, 04:39 PM
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
05-08-2015, 04:45 PM
mperrah (http://www.vbaexpress.com/forum/member.php?1686-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
05-08-2015, 05:17 PM
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
05-08-2015, 05:35 PM
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
05-08-2015, 05:52 PM
Thanks p45cal (http://www.vbaexpress.com/forum/member.php?3494-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
05-08-2015, 06:01 PM
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
05-09-2015, 01:20 AM
Maybe try using a Dictionary.. Loop though your values.. adding them to the Dictionary.. then.. the Unique values will be the Keys..

snb
05-09-2015, 09:02 AM
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
05-09-2015, 12:40 PM
snb (http://www.vbaexpress.com/forum/member.php?44644-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
05-09-2015, 01:38 PM
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
05-09-2015, 02:31 PM
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
05-14-2015, 10:47 AM
p45cal (http://www.vbaexpress.com/forum/member.php?3494-p45cal) Thanks for the observation.

snb (http://www.vbaexpress.com/forum/member.php?44644-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
05-14-2015, 11:03 AM
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
05-14-2015, 02:19 PM
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
05-24-2015, 10:31 AM
Hi:
Did NOT see these posts alerts in my email.
mperrah (http://www.vbaexpress.com/forum/member.php?1686-mperrah) : Interesting idea! Thanks.


Thanks p45cal (http://www.vbaexpress.com/forum/member.php?3494-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