Macro for Listing Unique Cells

[CARLOS]

I have a list similar to this:

A
B
A
C
A
A
A
C
B
B

I would like to create a new list with a macro that list
out the unique entries A,B,C

Thank You in Advance

 

[Don Guillett]

try recording a macro using data>filter>advanced filter

 

[Frank Kabel]

Hi
would you also accept a solution without a macro. If yes try the
following:
Assumption your data is in A1:Ann
put the following in B1:
=A1
and in B2 enter
=IF(COUNTIF($B$1:$B1,A2)>0,"",A2)
copy this down

 

[Guest]

THANKS. If I don't know the "criteria" I don't think the
advanced filter will work. I was thinking that something
like the "subtotal" function might work. Is there a macro
that can handle this ?

 

[Ola Lövgren]

Hi

If you don't need a macro it's simple to use an advanced filter. You don't have to enter a criteria range. Just tell Excel you want Unique records only. If you wish you can copy the list to another location. You can record this in a macro and the criteria range will be omitted

Range("A1:A8").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=Tru

In order to get the right result you need a title row. If you just do it on the list in youre example the firts A will be seen as a Title for the column and you will get two letter A in the list

If you want a macro that goes through the list you can use this macro (it assumes that the list doesn't have any title)

It takes two parameters
strListAddress - a string that tells the address of the list you want to filte
strNewListStart - a string with the address of the first cell in the new list with uniqe values that the macro generates

Sub FilterUniqeValues(ByVal strListAddress As String, ByVal strNewListStart As String
Dim lngCounter As Lon
Dim lngNumValues As Lon
Dim varUniqeValues() As Varian
Dim rngList As Rang
Dim rngCell As Rang
Dim rngTarget As Rang
Dim blnAllreadyInList As Boolea

lngCounter =
lngNumValues =
ReDim varUniqeValues(lngNumValues) As Varian

Set rngList = ActiveSheet.Range(strListAddress
varUniqeValues(0) = rngList.Cells(1, 1).Valu

Set rngTarget = ActiveSheet.Range(strNewListStart
rngTarget.Value = rngList.Cells(1, 1).Valu

For Each rngCell In rngList.Cell
blnAllreadyInList = Fals
For lngCounter = 0 To lngNumValue
If rngCell.Value = varUniqeValues(lngCounter) The
blnAllreadyInList = Tru
End I
Nex

If Not blnAllreadyInList The
lngNumValues = lngNumValues +
ReDim Preserve varUniqeValues(lngNumValues) As Varian

varUniqeValues(lngNumValues) = rngCell.Valu

Set rngTarget = rngTarget.Offset(1, 0
rngTarget = rngCel
End I
Nex

Set rngCell = Nothin
Set rngTarget = Nothin
Set rngList = Nothin
End Su

I think it's possible to make it simpler but it works rather well


----- CARLOS wrote: ----

I have a list similar to this












I would like to create a new list with a macro that list
out the unique entries A,B,

Thank You in Advanc