View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
NickHK NickHK is offline
external usenet poster
 
Posts: 4,391
Default Select Distinct from Array

Alan,
Using a Collection, you add each array(i) value to the collection as the
Key.
Because key values must be unique, it will error if you try to add a
duplicate :

Dim arr As Variant
Dim col As Collection
Dim i As Long
Const Vals As String = "a,b,b,d,e,f,a,g,f,h,t"

'Make an array
arr = Split(Vals, ",")

'create an instance of a collection
Set col = New Collection

On Error Resume Next
For i = LBound(arr) To UBound(arr)
'This will error if arr(i) already exist in the collection
col.Add arr(i), arr(i)
Next
On Error GoTo 0

MsgBox "Started with " & i - 1 & " elements in array." & vbNewLine _
& i - 1 - col.Count & " duplicate values removed."

For the array, it is not necessary to sort, but it makes it easier.
Then you can compare arr(i) with arr(i+1) to see if it is duplicate.
Without sorting, you have to compare arr(i) to all previous values.

Personally, I prefer using a collection.

NickHK

"Alan Beban" <unavailable wrote in message
...
NickHK wrote:
You can do a similar thing with a Collection and then you don't need the
Scripting reference.


Could you post the comparable code for a Collection approach?
Or sort your array first, then step through the elements copy distinct
elements to a new array.


Why is it necessary to sort the array first?

Alan

NickHK

"Lazzaroni" wrote in message
...
I was looking for a simple way to remove duplicates from an array;

something
that was equivalent to running a SELECT DISTINCT. I didn't find exactly

what
I was looking for but I found something close and modified it.

Hopefully
someone else will find this useful, or perhaps even improve upon it.

Function DistinctArray(oInputArray, _
Optional MatchCase As Boolean = True, _
Optional OmitBlanks As Boolean = True)

'declare the variables
Dim oOutputArray As Variant
Dim oElement As Variant
Dim oDictionary As Dictionary

'create new dictionary object
'requires Microsoft Scripting Runtime reference
Set oDictionary = New Dictionary

'set case sensitivity
oDictionary.CompareMode = Abs(Not MatchCase)

'load elements from array into dictionary replacing duplicates
For Each oElement In oInputArray
oDictionary.Item(CStr(oElement)) = oElement
Next

'delete any blanks
If OmitBlanks Then
If oDictionary.Exists("") Then oDictionary.Remove ("")
End If

'load dictionary items into new array
oOutputArray = oDictionary.Items

'return the new array with distinct values only
DistinctArray = oOutputArray

End Function

The original function can be found he
http://home.pacbell.net/beban/