Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
JaneC
 
Posts: n/a
Default Formula to list unique values

Hi,

I have the below list of values:

1
1
1
2
2
3
4
6
6

What I want to do is show a list of the unique values ie. Get rid of the
repeated values and only show one of each, so that the list looks as follows:

1
2
3
4
6

Can anybody please tell me how I can do this without manually going through
and deleting the repeated values??? I am using Excel 2003

Thanks!

JaneC

  #2   Report Post  
Alan Beban
 
Posts: n/a
Default

JaneC wrote:
Hi,

I have the below list of values:

1
1
1
2
2
3
4
6
6

What I want to do is show a list of the unique values ie. Get rid of the
repeated values and only show one of each, so that the list looks as follows:

1
2
3
4
6

Can anybody please tell me how I can do this without manually going through
and deleting the repeated values??? I am using Excel 2003

Thanks!

JaneC

If you paste the first of the following functions into a general module
in your workbook, click on Tools|References and check Microsoft
Scripting Runtime, the function can be used to produce an array of
unique items from a range or array. The ArrayUniquesLtd() function will
work if the number of unique items is less than 5462 or if you are using
xl2002 or later. Otherwise, if you paste instead the 2nd and 3rd
functions below (again checking the reference to Microsoft Scripting
Runtime), the ArrayUniques() function will extract the unique values.

Watch for word wrap, particularly in the ArrayTranspose() function:

Function ArrayUniquesLtd(InputArray, _
Optional MatchCase As Boolean = True, _
Optional Base_Orient As String = "1vert", _
Optional OmitBlanks As Boolean = True)
'THIS PROCEDURE REQUIRES A PROJECT REFERENCE
'TO "MICROSCOPIC SCRIPTING RUNTIME".
'The function returns an array of unique values
'from an array or range, by default omitting
'blanks and empty strings; to include an empty
'string (or a zero for a blank), use False as
'the 4th parameter. By default the function
'returns a 1-based vertical array; for other
'results enter "0horiz", "1horiz" or "0vert" as
'the 3rd parameter. By default, the function is
'case-sensitive; i.e., e.g., "red" and "RED" are
'treated as two separate unique values; to
'avoid case-sensitivity, enter False as the
'2nd parameter.


'Declare the variables
Dim arr, arr2
Dim i As Long, p As Object, q As String
Dim Elem, x As Dictionary
Dim CalledDirectFromWorksheet As Boolean


'For later use in selecting cells for worksheet output
CalledDirectFromWorksheet = False
If TypeOf Application.Caller Is Range Then
Set p = Application.Caller
q = p.Address
iRows = Range(q).Rows.Count
iCols = Range(q).Columns.Count
If InStr(1, p.FormulaArray, "ArrayUniques") = 2 _
Or InStr(1, p.FormulaArray, "arrayuniques") = 2 _
Or InStr(1, p.FormulaArray, "ARRAYUNIQUES") = 2 Then
CalledDirectFromWorksheet = True
End If
End If


'Convert an input range to a VBA array
arr = InputArray


'Load the unique elements into a Dictionary Object
Set x = New Dictionary


x.CompareMode = Abs(Not MatchCase) '<--Case-sensitivity
On Error Resume Next
For Each Elem In arr
x.Add Item:=Elem, key:=CStr(Elem)
Next
If OmitBlanks Then x.Remove ("")
On Error GoTo 0

'Load a 0-based horizontal array with the unique
'elements from the Dictionary Object
arr2 = x.Items


'This provides appropriate base and orientation
'of the output array
Select Case Base_Orient
Case "0horiz"
arr2 = arr2
Case "1horiz"
ReDim Preserve arr2(1 To UBound(arr2) + 1)
Case "0vert"
arr2 = Application.Transpose(arr2)
Case "1vert"
ReDim Preserve arr2(1 To UBound(arr2) + 1)
arr2 = Application.Transpose(arr2)
End Select


'Assure that enough cells are selected to accommodate output
If CalledDirectFromWorksheet Then
If Range(Application.Caller.Address).Count < x.Count Then
ArrayUniquesLtd = "Select a range of at least " & x.Count & " cells"
Exit Function
End If
End If


ArrayUniquesLtd = arr2


End Function


Function ArrayUniques(InputArray, _
Optional MatchCase As Boolean = True, _
Optional Base_Orient As String = "1vert", _
Optional OmitBlanks As Boolean = True)
'THIS PROCEDURE REQUIRES A PROJECT REFERENCE
'TO "MICROSCOPIC SCRIPTING RUNTIME".
'The function returns an array of unique
'values from an array or range. By default
'it returns a 1-based vertical array; for
'other results enter "0horiz", "1horiz" or
'"0vert" as the third argument. By default,
'the function is case-sensitive; i.e., e.g.,
'"red" and "Red" are treated as two separate
'unique values; to avoid case-sensitivity,
'enter False as the second argument.


'Declare the variables
Dim arr, arr2
Dim i As Long, p As Object, q As String
Dim Elem, x As Dictionary
Dim CalledDirectFromWorksheet As Boolean


'For later use in selecting cells for worksheet output
CalledDirectFromWorksheet = False
If TypeOf Application.Caller Is Range Then
Set p = Application.Caller
q = p.Address
iRows = Range(q).Rows.Count
iCols = Range(q).Columns.Count
If InStr(1, p.FormulaArray, "ArrayUniques") = 2 _
Or InStr(1, p.FormulaArray, "arrayuniques") = 2 _
Or InStr(1, p.FormulaArray, "ARRAYUNIQUES") = 2 Then
CalledDirectFromWorksheet = True
End If
End If


'Convert an input range to a VBA array
arr = InputArray


'Load the unique elements into a Dictionary Object
Set x = New Dictionary


x.CompareMode = Abs(Not MatchCase) '<--Case-sensitivity
On Error Resume Next
For Each Elem In arr
x.Add Item:=Elem, key:=CStr(Elem)
Next
If OmitBlanks Then x.Remove ("")
On Error GoTo 0

'Load a 0-based horizontal array with the unique
'elements from the Dictionary Object
arr2 = x.Items


'This provides appropriate base and orientation
'of the output array
Select Case Base_Orient
Case "0horiz"
arr2 = arr2
Case "1horiz"
ReDim Preserve arr2(1 To UBound(arr2) + 1)
Case "0vert"
If x.Count < 5461 Or Application.Version 9 Then
arr2 = Application.Transpose(arr2)
Else
arr2 = ArrayTranspose(arr2)
End If
Case "1vert"
ReDim Preserve arr2(1 To UBound(arr2) + 1)
If x.Count < 5461 Or Application.Version 9 Then
arr2 = Application.Transpose(arr2)
Else
arr2 = ArrayTranspose(arr2)
End If
End Select


'Assure that enough cells are selected to accommodate output
If CalledDirectFromWorksheet Then
If Range(Application.Caller.Address).Count < x.Count Then
ArrayUniques = "Select a range of at least " & x.Count & " cells"
Exit Function
End If
End If


ArrayUniques = arr2


End Function


Function ArrayTranspose(InputArray)
'This function returns the transpose of
'the input array or range; it is designed
'to avoid the limitation on the number of
'array elements and type of array that the
'worksheet TRANSPOSE Function has.


'Declare the variables
Dim outputArrayTranspose As Variant, arr As Variant, p As Integer
Dim i As Long, j As Long


'Check to confirm that the input array
'is an array or multicell range
If IsArray(InputArray) Then


'If so, convert an input range to a
'true array
arr = InputArray


'Load the number of dimensions of
'the input array to a variable
On Error Resume Next


'Loop until an error occurs
i = 1
Do
z = UBound(arr, i)
i = i + 1
Loop While Err = 0


'Reset the error value for use with other procedures
Err = 0


'Return the number of dimensions
p = i - 2
End If


If Not IsArray(InputArray) Or p 2 Then


Msg = "#ERROR! The function accepts only multi-cell ranges and
1D or 2D arrays."
If TypeOf Application.Caller Is Range Then
ArrayTranspose = Msg
Else
MsgBox Msg, 16
End If
Exit Function
End If

'Load the output array from a one-
'dimensional input array
If p = 1 Then


Select Case TypeName(arr)
Case "Object()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Object
For i = LBound(outputArrayTranspose) To
UBound(outputArrayTranspose)
Set outputArrayTranspose(i,
LBound(outputArrayTranspose)) = arr(i)
Next
Case "Boolean()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Boolean
Case "Byte()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Byte
Case "Currency()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Currency
Case "Date()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Date
Case "Double()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Double
Case "Integer()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Integer
Case "Long()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Long
Case "Single()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Single
Case "String()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), LBound(arr, 1) To UBound(arr, 1)) As String
Case "Variant()"
ReDim outputArrayTranspose(LBound(arr) To UBound(arr),
LBound(arr) To LBound(arr)) As Variant
Case Else


Msg = "#ERROR! Only built-in types of arrays are
supported."
If TypeOf Application.Caller Is Range Then
ArrayTranspose = Msg
Else
MsgBox Msg, 16
End If
Exit Function
End Select
If TypeName(arr) < "Object()" Then
For i = LBound(outputArrayTranspose) To
UBound(outputArrayTranspose)
outputArrayTranspose(i, LBound(outputArrayTranspose)) =
arr(i)
Next
End If

'Or load the output array from a two-
'dimensional input array or range
ElseIf p = 2 Then
Select Case TypeName(arr)
Case "Object()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Object
For i = LBound(outputArrayTranspose) To _
UBound(outputArrayTranspose)
For j = LBound(outputArrayTranspose, 2) To _
UBound(outputArrayTranspose, 2)
Set outputArrayTranspose(i, j) = arr(j, i)
Next
Next
Case "Boolean()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Boolean
Case "Byte()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Byte
Case "Currency()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Currency
Case "Date()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Date
Case "Double()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Double
Case "Integer()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Integer
Case "Long()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Long
Case "Single()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Single
Case "String()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As String
Case "Variant()"
ReDim outputArrayTranspose(LBound(arr, 2) To
UBound(arr, 2), _
LBound(arr) To UBound(arr)) As Variant
Case Else


Msg = "#ERROR! Only built-in types of arrays are
supported."
If TypeOf Application.Caller Is Range Then
ArrayTranspose = Msg
Else
MsgBox Msg, 16
End If
Exit Function
End Select
If TypeName(arr) < "Object()" Then
For i = LBound(outputArrayTranspose) To _
UBound(outputArrayTranspose)
For j = LBound(outputArrayTranspose, 2) To _
UBound(outputArrayTranspose, 2)
outputArrayTranspose(i, j) = arr(j, i)
Next
Next
End If
End If

'Return the transposed array
ArrayTranspose = outputArrayTranspose
End Function


  #3   Report Post  
Ken Wright
 
Posts: n/a
Default

Data / Filter / Advanced Filter / 'Copy to another location' and 'Unique values
only'

Then replace original list with new list

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission :-)
----------------------------------------------------------------------------



"JaneC" wrote in message
...
Hi,

I have the below list of values:

1
1
1
2
2
3
4
6
6

What I want to do is show a list of the unique values ie. Get rid of the
repeated values and only show one of each, so that the list looks as follows:

1
2
3
4
6

Can anybody please tell me how I can do this without manually going through
and deleting the repeated values??? I am using Excel 2003

Thanks!

JaneC



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.808 / Virus Database: 550 - Release Date: 09/12/2004


  #4   Report Post  
Jason Morin
 
Posts: n/a
Default

If your data set were in A1:A10, place this in B1, press
ctrl/shift/enter, and fill down until you receive errors.

=INDEX($A$1:$A$10,SMALL(IF(ROW($A$1:$A$10)=MATCH
($A$1:$A$10,$A$1:$A$10,0),ROW($A$1:$A$10)),ROW()))

HTH
Jason
Atlanta, GA

-----Original Message-----
Hi,

I have the below list of values:

1
1
1
2
2
3
4
6
6

What I want to do is show a list of the unique values

ie. Get rid of the
repeated values and only show one of each, so that the

list looks as follows:

1
2
3
4
6

Can anybody please tell me how I can do this without

manually going through
and deleting the repeated values??? I am using Excel 2003

Thanks!

JaneC

.

  #5   Report Post  
Bob Phillips
 
Posts: n/a
Default

Jane,

assuming the source data is in A1:A20

In B1: =A1
In
B2:=IF(ISERROR(MATCH(0,COUNTIF(B$1:B1,$A$1:$A$20&" "),0)),"",INDEX(IF(ISBLANK
($A
$1:$A$20),"",$A$1:$A$20),MATCH(0,COUNTIF(B$1:B1,$A $1:$A$20&""),0)))

B2 is an array bormula, so commit with Ctrl-Shift-Enter, and copy B2 down as
far as you need

--

HTH

RP
(remove nothere from the email address if mailing direct)


"JaneC" wrote in message
...
Hi,

I have the below list of values:

1
1
1
2
2
3
4
6
6

What I want to do is show a list of the unique values ie. Get rid of the
repeated values and only show one of each, so that the list looks as

follows:

1
2
3
4
6

Can anybody please tell me how I can do this without manually going

through
and deleting the repeated values??? I am using Excel 2003

Thanks!

JaneC



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Extracting Values on one list and not another B Schwarz Excel Discussion (Misc queries) 4 January 7th 05 02:48 PM
Selecting data from a list based on entered values GrantM Excel Discussion (Misc queries) 1 December 20th 04 11:59 AM
How to display the "values" included in a formula vs. the cells? pcmoLAT Excel Worksheet Functions 2 December 10th 04 07:22 AM
List Box Values Mike Cramsey New Users to Excel 1 November 30th 04 02:51 AM
manipulating formula values Ramy Excel Worksheet Functions 4 November 19th 04 05:54 PM


All times are GMT +1. The time now is 05:27 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"