' RemoveDuplicatesFromArray(arrItems : Array) ' ---------------------------------------------------------------------------- ' Entfernt doppelte Einträge aus Ein-Dimensionalen Arrays ' ' Source: https://devblogs.microsoft.com/scripting/how-can-i-delete-duplicate-items-from-an-array/ ' ' Returns: RemoveDuplicatesFromArray : Array ' ---------------------------------------------------------------------------- ' Copyright (c) 2021 by Digital Data GmbH ' ' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim ' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works ' ---------------------------------------------------------------------------- ' Creation Date / Author: 10.08.2020 / MK ' Version Date / Editor: 10.08.2020 / MK ' Version Number: 1.0.0.0 Function RemoveDuplicatesFromArray(arrItems) If (Ubound(arrItems) >= 0) Then If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: BEFORE deduplication!" End If Set objDictionary = CreateObject("Scripting.Dictionary") For Each strItem in arrItems If Not objDictionary.Exists(strItem) Then objDictionary.Add strItem, strItem End If Next intItems = objDictionary.Count - 1 ReDim arrItems(intItems) i = 0 For Each strKey in objDictionary.Keys arrItems(i) = strKey i = i + 1 Next If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: AFTER deduplication!" End If End If RemoveDuplicatesFromArray = arrItems End Function