# Microsoft Office Application Help - Excel Help forum > Excel Formulas & Functions >  > [SOLVED] howto select distinct values from list

## chris

I have a list of the format:

ITEM  DATE
----  ----
UK    200401
UK    200402
UK    200403
UK    200404
UK    200405
IT    200401
IT    200402
...    ......

The list is created from a database via MS Query, sort order 1,2.

The vales for ITEM and DATE will vary each time the query is
refreshed.

I would like to setup a range that contains only a list of the grouped
by ITEM.  I could do this with another query (select distinct ITEM
from X), but the queries take to long.  How can I do this with excel
functions?

The required dataset (from the above example):

ITEM
----
UK
IT

Thanks in advance,

Chris

----------


## Trevor Shuttleworth

Chris

use Advanced Filter, select unique items and copy to a new range

Regards

Trevor


"chris" <nadsinoz@hotmail.com> wrote in message
news:b8996f29.0504152236.4808eda7@posting.google.com...
>I have a list of the format:
>
> ITEM  DATE
> ----  ----
> UK    200401
> UK    200402
> UK    200403
> UK    200404
> UK    200405
> IT    200401
> IT    200402
> ..    ......
>
> The list is created from a database via MS Query, sort order 1,2.
>
> The vales for ITEM and DATE will vary each time the query is
> refreshed.
>
> I would like to setup a range that contains only a list of the grouped
> by ITEM.  I could do this with another query (select distinct ITEM
> from X), but the queries take to long.  How can I do this with excel
> functions?
>
> The required dataset (from the above example):
>
> ITEM
> ----
> UK
> IT
>
> Thanks in advance,
>
> Chris

----------


## Fadi Chalouhi

Hi Chris,

You can create a UDF (IUser-Defined Function) to generate this list for
you. Check this post :
http://www.chalouhis.com/XLBLOG/arch.../unique-cells/

HTH

Fadi

----------


## Biff

Hi!

Here's one way:

Assume:

A1 = ITEM
A2 = ----
A3:An = UK, IT, etc..

D1 = header ITEM
D2 = ----
D3 = empty, leave this cell empty
D4 = formula entered with the key combo of CTRL,SHIFT,ENTER

=IF(ISNA(MATCH(0,COUNTIF($D$3:D3,list),0)),"",INDEX(list,MATCH(0,COUNTIF($D$3:D3,list),0)))

list is a defined dynamic range:

=OFFSET(Sheet1!$A$3,,,COUNTA(Sheet1!$A:$A)-2,1)

This assumes there will be no empty cells within the query list in column A.

Now, you have to copy this formula down to enough cells that will cover the
expected number of uniques returned. Will that be 100 cells? 500 cells?

Biff

"chris" <nadsinoz@hotmail.com> wrote in message
news:b8996f29.0504152236.4808eda7@posting.google.com...
>I have a list of the format:
>
> ITEM  DATE
> ----  ----
> UK    200401
> UK    200402
> UK    200403
> UK    200404
> UK    200405
> IT    200401
> IT    200402
> ..    ......
>
> The list is created from a database via MS Query, sort order 1,2.
>
> The vales for ITEM and DATE will vary each time the query is
> refreshed.
>
> I would like to setup a range that contains only a list of the grouped
> by ITEM.  I could do this with another query (select distinct ITEM
> from X), but the queries take to long.  How can I do this with excel
> functions?
>
> The required dataset (from the above example):
>
> ITEM
> ----
> UK
> IT
>
> Thanks in advance,
>
> Chris

----------


## keepITcool

Fadi,

The code may come from JWalk but is painfully slow
It takes 14 seconds on an array of 1000 elements..
dont think of running it on 2000 or more.

Following will work effortless with large arrays, and returns
5000 sorted uniques from 60000 text set in under .5 seconds.


Option Explicit
Option Compare Text

Public Function Uniques(ByVal vSourceArray As Variant, _
Optional ByVal Sorted As Byte, _
Optional ByVal CountOnly As Boolean)
'author:keepITcool

'Requires Ref to Microsoft Scripting Runtime
Dim oDic     As Dictionary
Dim n&, l&, v, itm

'Initialize the dictionary
Set oDic = New Dictionary
oDic.CompareMode = TextCompare

'Exit if no array
If Not IsArray(vSourceArray) Then GoTo theExit
'Take values if Range
If TypeName(vSourceArray) = "Range" Then vSourceArray = vSourceArray

'Key must be unique, so doubles give (ignored) errors
On Error Resume Next
For Each itm In vSourceArray
oDic.Add itm, itm
Next
'Quicker then testing for empties, just remove it
oDic.Remove vbNullString

On Error GoTo theError

If CountOnly Then
v = oDic.Count
Else
v = oDic.Items
'make 1based for compatibility
ReDim Preserve v(1 To UBound(v) - LBound(v) + 1)
Select Case Sorted
Case Is > 0: Call QSort(v, xlAscending)
Case Is < 0: Call QSort(v, xlDescending)
End Select
End If

theExit:
Uniques = v
Exit Function
theError:
Uniques = CVErr(xlErrValue)

End Function

Public Sub QSort(v, _
Optional SortOrder As XlSortOrder = xlAscending, _
Optional n& = True, Optional m& = True)
Dim i&, j&, p, t
If n = True Then n = LBound(v)
If m = True Then m = UBound(v)
i = n: j = m: p = v((n + m) \ 2)
While (i <= j)
While (v(i) < p And i < m): i = i + 1: Wend
While (v(j) > p And j > n): j = j - 1: Wend
If (i <= j) Then
t = v(i): v(i) = v(j): v(j) = t
i = i + 1: j = j - 1
End If
Wend
If (n < j) Then QSort v, SortOrder, n, j
If (i < m) Then QSort v, SortOrder, i, m
End Sub


--
keepITcool
|  www.XLsupport.com | keepITcool chello nl | amsterdam


Fadi Chalouhi wrote :

> Hi Chris,
>
> You can create a UDF (IUser-Defined Function) to generate this list
> for you. Check this post :
> http://www.chalouhis.com/XLBLOG/arch.../unique-cells/
>
> HTH
>
> Fadi

----------


## Biff

Hi!

What are the arguments to this udf?

The first is obvious. The third looks to be a boolean TRUE or FALSE but what
does TRUE or FALSE mean?  I don't have a clue about the 2nd.

Biff

"keepITcool" <xrrcvgpbby@puryyb.ay> wrote in message
news:xn0e12kv4301bbc004keepitcoolnl@msnews.microsoft.com...
> Fadi,
>
> The code may come from JWalk but is painfully slow
> It takes 14 seconds on an array of 1000 elements..
> dont think of running it on 2000 or more.
>
> Following will work effortless with large arrays, and returns
> 5000 sorted uniques from 60000 text set in under .5 seconds.
>
>
> Option Explicit
> Option Compare Text
>
> Public Function Uniques(ByVal vSourceArray As Variant, _
>                           Optional ByVal Sorted As Byte, _
>                           Optional ByVal CountOnly As Boolean)
> 'author:keepITcool
>
> 'Requires Ref to Microsoft Scripting Runtime
>  Dim oDic     As Dictionary
>  Dim n&, l&, v, itm
>
>  'Initialize the dictionary
>  Set oDic = New Dictionary
>  oDic.CompareMode = TextCompare
>
>  'Exit if no array
>  If Not IsArray(vSourceArray) Then GoTo theExit
>  'Take values if Range
>  If TypeName(vSourceArray) = "Range" Then vSourceArray = vSourceArray
>
>  'Key must be unique, so doubles give (ignored) errors
>  On Error Resume Next
>  For Each itm In vSourceArray
>    oDic.Add itm, itm
>  Next
>  'Quicker then testing for empties, just remove it
>  oDic.Remove vbNullString
>
>  On Error GoTo theError
>
>  If CountOnly Then
>    v = oDic.Count
>  Else
>    v = oDic.Items
>    'make 1based for compatibility
>    ReDim Preserve v(1 To UBound(v) - LBound(v) + 1)
>    Select Case Sorted
>    Case Is > 0: Call QSort(v, xlAscending)
>    Case Is < 0: Call QSort(v, xlDescending)
>    End Select
>  End If
>
> theExit:
>  Uniques = v
>  Exit Function
> theError:
>  Uniques = CVErr(xlErrValue)
>
> End Function
>
> Public Sub QSort(v, _
>                   Optional SortOrder As XlSortOrder = xlAscending, _
>                   Optional n& = True, Optional m& = True)
>  Dim i&, j&, p, t
>  If n = True Then n = LBound(v)
>  If m = True Then m = UBound(v)
>  i = n: j = m: p = v((n + m) \ 2)
>  While (i <= j)
>    While (v(i) < p And i < m): i = i + 1: Wend
>    While (v(j) > p And j > n): j = j - 1: Wend
>    If (i <= j) Then
>      t = v(i): v(i) = v(j): v(j) = t
>      i = i + 1: j = j - 1
>    End If
>  Wend
>  If (n < j) Then QSort v, SortOrder, n, j
>  If (i < m) Then QSort v, SortOrder, i, m
> End Sub
>
>
> --
> keepITcool
> |  www.XLsupport.com | keepITcool chello nl | amsterdam
>
>
> Fadi Chalouhi wrote :
>
>> Hi Chris,
>>
>> You can create a UDF (IUser-Defined Function) to generate this list
>> for you. Check this post :
>> http://www.chalouhis.com/XLBLOG/arch.../unique-cells/
>>
>> HTH
>>
>> Fadi

----------


## keepITcool

I hoped it would be obvious from the code  :Smilie: 

Sorted =0 or omitted, not sorted
Sorted >0, xlAscending
Sorted <0, xlDescending

CountOnly = true
Do not return the array of unique items, but the count only


--
keepITcool
|  www.XLsupport.com | keepITcool chello nl | amsterdam


Biff wrote :

> Hi!
>
> What are the arguments to this udf?
>
> The first is obvious. The third looks to be a boolean TRUE or FALSE
> but what does TRUE or FALSE mean?  I don't have a clue about the 2nd.
>
> Biff
>
> "keepITcool" <xrrcvgpbby@puryyb.ay> wrote in message
> news:xn0e12kv4301bbc004keepitcoolnl@msnews.microsoft.com...
> > Fadi,
> >
> > The code may come from JWalk but is painfully slow
> > It takes 14 seconds on an array of 1000 elements..
> > dont think of running it on 2000 or more.
> >
> > Following will work effortless with large arrays, and returns
> > 5000 sorted uniques from 60000 text set in under .5 seconds.
> >
> >
> > Option Explicit
> > Option Compare Text
> >
> > Public Function Uniques(ByVal vSourceArray As Variant, _
> >                           Optional ByVal Sorted As Byte, _
> >                           Optional ByVal CountOnly As Boolean)
> > 'author:keepITcool
> >
> > 'Requires Ref to Microsoft Scripting Runtime
> >  Dim oDic     As Dictionary
> >  Dim n&, l&, v, itm
> >
> >  'Initialize the dictionary
> >  Set oDic = New Dictionary
> >  oDic.CompareMode = TextCompare
> >
> >  'Exit if no array
> >  If Not IsArray(vSourceArray) Then GoTo theExit
> >  'Take values if Range
> >  If TypeName(vSourceArray) = "Range" Then vSourceArray =
> > vSourceArray
> >
> >  'Key must be unique, so doubles give (ignored) errors
> >  On Error Resume Next
> >  For Each itm In vSourceArray
> >    oDic.Add itm, itm
> >  Next
> >  'Quicker then testing for empties, just remove it
> >  oDic.Remove vbNullString
> >
> >  On Error GoTo theError
> >
> >  If CountOnly Then
> >    v = oDic.Count
> >  Else
> >    v = oDic.Items
> >    'make 1based for compatibility
> >    ReDim Preserve v(1 To UBound(v) - LBound(v) + 1)
> >    Select Case Sorted
> >    Case Is > 0: Call QSort(v, xlAscending)
> >    Case Is < 0: Call QSort(v, xlDescending)
> >    End Select
> >  End If
> >
> > theExit:
> >  Uniques = v
> >  Exit Function
> > theError:
> >  Uniques = CVErr(xlErrValue)
> >
> > End Function
> >
> > Public Sub QSort(v, _
> >                   Optional SortOrder As XlSortOrder = xlAscending, _
> >                   Optional n& = True, Optional m& = True)
> >  Dim i&, j&, p, t
> >  If n = True Then n = LBound(v)
> >  If m = True Then m = UBound(v)
> >  i = n: j = m: p = v((n + m) \ 2)
> >  While (i <= j)
> >    While (v(i) < p And i < m): i = i + 1: Wend
> >    While (v(j) > p And j > n): j = j - 1: Wend
> >    If (i <= j) Then
> >      t = v(i): v(i) = v(j): v(j) = t
> >      i = i + 1: j = j - 1
> >    End If
> >  Wend
> >  If (n < j) Then QSort v, SortOrder, n, j
> >  If (i < m) Then QSort v, SortOrder, i, m
> > End Sub
> >
> >
> > --
> > keepITcool
> > >   www.XLsupport.com | keepITcool chello nl | amsterdam
> >
> >
> > Fadi Chalouhi wrote :
> >
> >> Hi Chris,
> > >
> >> You can create a UDF (IUser-Defined Function) to generate this list
> >> for you. Check this post :
> >> http://www.chalouhis.com/XLBLOG/arch.../unique-cells/
> > >
> >> HTH
> > >
> >> Fadi

----------


## kisanvikas2015

Hi all,

Can someone please help me.

Is this solution works for distinct positive values.
I mean if there are values like -1, 5, #REF, 5, 1

Answer should be 2.

Regards,
Vikas

----------


## protonLeah

@kisanvikas2015,
Unfortunately _your post does not comply with Rule 2 of our Forum_ RULES. *Do not post a question in the thread of another member -- start your own thread.* 

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread. 

Old threads are often only monitored by the original participants.  New threads not only open you up to all possible participants again, they typically get faster response, too.

When you joined the forum recently you agreed to abide by the Forum Rules, but in haste I fear you might not have actually read them. Please stop and take a moment to read them now. We all follow these rules for the benefit of all, as must you. Thanks.

_(link above in the menu bar)_

----------

