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/

You can do a similar thing with a Collection and then you don't need the
Scripting reference.
Or sort your array first, then step through the elements copy distinct
elements to a new array.

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/

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/

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/

NickHK wrote:
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."

Yes. The reason I asked is that my recollection is that Dictionaries
allow the features of matching case (or not) and omitting blanks (or
not), as the posted code does, and that Collections don't provide the
required features. I could be wrong.


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.

I was thinking something like

Dim arr1(), arr2()
arr1 = Range("whatever")
i = 1
For Each elem in arr1
If IsError(Application.Match(elem, arr2, 0)) Then
arr2(i) = elem
i = i + 1
End if
Next

which doesn't rely on sorting.

Alan Beban

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/

Alan,
For the Collection, if you made the routine a function, you could have a
CaseInsensitive argument, and if True, just LCase the keys before adding.
Omitting blanks code be included.

As for the sorting, using a non-VBA construct works fine, but without that,
I find it easier to sort first.

NickHK

"Alan Beban" <unavailable wrote in message
...
NickHK wrote:
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."

Yes. The reason I asked is that my recollection is that Dictionaries
allow the features of matching case (or not) and omitting blanks (or
not), as the posted code does, and that Collections don't provide the
required features. I could be wrong.


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.

I was thinking something like

Dim arr1(), arr2()
arr1 = Range("whatever")
i = 1
For Each elem in arr1
If IsError(Application.Match(elem, arr2, 0)) Then
arr2(i) = elem
i = i + 1
End if
Next

which doesn't rely on sorting.

Alan Beban

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/