How to remove duplicates from an array?

Question

I am trying to remove duplicate values from an array.

I came across this solution: http://www.livio.net/main/asp_functions.asp?id=RemDups%20Function

It works fine if I hard code an array, via e.g.

theArray = Array("[email protected]","[email protected]","[email protected]","[email protected]","[email protected]","[email protected]")

The duplicates are removed via the test steps shown on the livio.net page:

'--- show array before modifications
response.write "before:<HR>" & showArray (theArray)

'---- remove duplicate string values
theArray = RemDups(theArray)

'--- show the array with no duplicate values
response.write "after:" & showArray (theArray)

However, I am trying to remove duplicates from values which are entered into a textarea on a form.

Assuming I've got the addresses in a standard format where they are comma separated, and are stored in a string called "whotoemail"

So, "whotoemail" contains:

[email protected],[email protected],[email protected],[email protected],[email protected],[email protected]

I tried declaring my array as:

theArray = Array(whotoemail)

Then running through the test steps - the duplicates are not removed. It doesn't seem to recognise that the array has been declared at all, or that it contains any values.

I then thought, maybe the values need to be wrapped in speech marks, so I fudged a clunky way to do that:

testing = Split(whotoemail,",")
loop_address = ""
For i=0 to UBound(testing)
  loop_address = loop_address & "," & chr(34) & trim(testing(i)) & chr(34)
Next

' remove leading comma
left_comma = left(loop_address,1)
if left_comma = "," then
    ttl_len = len(loop_address)
    loop_address = right(loop_address,ttl_len-1)
end if

So now my "whotoemail" string is wrapped in speech marks, just like when I hard coded the Array.

But still the duplicate values are not removed.

Is it not possible to dynamically set the values of the array when declaring the array?

Or am I missing something obvious?

Any advice would be hugely appreciated.

Thanks!

Remarkebly you do know the split function, but you are not aware of the join function. Look it up, it will make your life much simpler in combination with the answer of Ansgar Wiechers. — AutomatedChaos
– AutomatedChaos, Commented Dec 3, 2013 at 9:05

Ansgar Wiechers · Accepted Answer · 2013-12-01 09:32:46Z

2

I'd use a dictionary for duplicate elimination, because the keys of a dictionary are by definition unique.

Function RemoveDuplicates(str)
  If Trim(str) = "" Then
    RemoveDuplicates = Array()
    Exit Function
  End If

  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = vbTextCompare  'make dictionary case-insensitive

  For Each elem In Split(str, ",")
    d(elem) = True
  Next

  RemoveDuplicates = d.Keys
End Function

answered Dec 1, 2013 at 9:32

Ansgar Wiechers

202k27 gold badges286 silver badges363 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

WilliamK Over a year ago

Error = Type mismatch, An unhandled data type was encountered.

MC ND · Accepted Answer · 2013-12-01 11:40:58Z

1

You have almost done it. Once you have included the RemDups code

' get the value of the text area (whereever you have it)
whotoemail = textAreaValue

' remove carriage returns
whotoemail = Replace(whotoemail, vbCR, "")

' replace line feeds with separator
whotoemail = Replace(whotoemail, vbLF, ",")

' replace line breaks with separator
whotoemail = Replace(whotoemail, "<br>", ",")

' remove duplicates from text
theArray = RemDups(Split(whotoemail,","))

answered Dec 1, 2013 at 11:40

MC ND

71.1k8 gold badges95 silver badges136 bronze badges

Comments

Moir · Accepted Answer · 2021-04-22 01:29:47Z

0

If you don't want a Dictionary you can use the following to compare each element in the array to itself.

Info = Array("[email protected]","[email protected]","[email protected]","[email protected]","[email protected]","[email protected]")

x = 0
z = ubound(Info)
Do
x = x + 1
Do
z = z - 1
If x = z Then
Info(x) = Info(z)
ElseIf Info(x) = Info(z) Then
Info(x) = ""
End If
Loop Until z=0
z = ubound(Info)
Loop Until x = ubound(Info)
For each x in Info 
If x <> "" Then
Unique = Unique & Chr(13) & x
End If
Next

MsgBox Unique

answered Apr 22, 2021 at 1:29

Moir

3874 silver badges14 bronze badges

Comments

John · Accepted Answer · 2013-12-01 11:38:11Z

-1

My Version:

Public Function RemoveDuplicate(byVal arrDuplicate())
Dim sdScriptingDictionary, Item, arrReturn

Set sdScriptingDictionary = CreateObject("Scripting.Dictionary")
sdScriptingDictionary.RemoveAll
sdScriptingDictionary.CompareMode = BinaryCompare
For Each Item In arrDuplicate
    'If item does not exist in dictionary d then add it
    If Not sdScriptingDictionary.Exists(Item) Then sdScriptingDictionary.Add Item, Item
    'If Not sdScriptingDictionary.Exists(item) Then
        'sdScriptingDictionary.Remove(item)
    'End If
Next
arrReturn = sdScriptingDictionary.keys

'Clean Up
Erase arrDuplicate
Set arrDuplicate = Nothing

sdScriptingDictionary.RemoveAll
Set sdScriptingDictionary = Nothing

RemoveDuplicate = arrReturn
End Function

answered Dec 1, 2013 at 11:38

John

1,3271 gold badge17 silver badges28 bronze badges

1 Comment

WilliamK Over a year ago

Error = Object not a collection

Collectives™ on Stack Overflow

How to remove duplicates from an array?

4 Answers 4

1 Comment

Comments

Comments

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

1 Comment

Comments

Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related