VBA: need unique values from a column

kweaver

Well-known Member
Joined
May 8, 2018
Messages
868
Office Version
365, 2010
In a worksheet (called Summary) I have values from G2 to Gn and I'd like column H from H2 to however long to be the unique values from G.
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
868
Office Version
365, 2010
Would this be the best way?

Code:
Range("G2:G" & LRsum).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H2"), Unique:=True
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,317
Office Version
2013
Platform
Windows
Try

Code:
Sub MM1()
Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("H2"), Unique:=True
End Sub
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
868
Office Version
365, 2010
For some reason (I don't know why), I had a repeat of the smallest value in the sorted list of the G column that got placed in the H column.

Maybe my explanation wasn't correctly worded. I want only 1 occurrence of each value in the H column.
 
Last edited:

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,643
Office Version
365, 2019, 2016
Platform
Windows
Try this.

Code:
Sub UNIQUE()
Dim AR() As Variant: AR = Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row).Value

With CreateObject("System.Collections.ArrayList")

For i = 1 To UBound(AR)
    If Not .Contains(AR(i, 1)) Then .Add AR(i, 1)
Next i

.Sort
Range("H2").Resize(.Count, 1).Value = Application.Transpose(.toArray)

End With
End Sub
 
Last edited:

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,643
Office Version
365, 2019, 2016
Platform
Windows
Testing Michael's solution, I think the problem is that it is expecting a header row. So, it's just going to repeat whatever is at the top of the range. Easy enough fix, just add a header column and change the ranges from G2 and H2 to G1 and H1.

Testing on 100,000 records, Michael's is a lot faster than mine as well. Mine took 0.62 seconds and his only took 0.03 seconds. So about 20x faster.

Can't really time it, but Power Query is a pretty fast option as well.

Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    RemoveDupes = Table.Distinct(Source),
    Sort = Table.Sort(RemoveDupes,{{"Column1", Order.Ascending}})
in
    Sort
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
868
Office Version
365, 2010
Thanks to both of you. I put a header in G1 and H1 (same header in each) and if I F8 my way through it using this:

Code:
Sheets("Summary").Range("G1:G" & LRsum).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("H1:H" & LRsum), Unique:=True
it works. But, when I don't stop the execution and try to have it run through without my stepping through, I get an "extract range has a missing..." error.

EDIT: ah ha...found it. I needed to remove "ActiveSheet" from the above code and specifically reference the Summary sheet. Phew! Thanks again!!!
 
Last edited:

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
42,734
Office Version
365
Platform
Windows
Code:
Sheets("Summary").Range("G1:G" & LRsum).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("H1:H" & LRsum), Unique:=True
EDIT: ah ha...found it. I needed to remove "ActiveSheet" from the above code and specifically reference the Summary sheet. Phew! Thanks again!!!
FWIW you only need to specify the first cell of the CopyTo range
Code:
CopyToRange:=Sheets("Summary").Range("H1")
 

Forum statistics

Threads
1,085,915
Messages
5,386,754
Members
402,019
Latest member
JLuby

Some videos you may like

This Week's Hot Topics

Top