VBA - Remove duplicate values of an array

Question

I want to remove the duplicated values of an sorted array.

Here is the code to sort the values in ascending order.

Dim k As Integer
Dim j As Integer
Dim sortedArray As Variant
Dim sorting As Boolean

If sorting = True Then
 For j = LBound(concentrationArray) To UBound(concentrationArray)
  For k = j + 1 To UBound(concentrationArray)
   If concentrationArray(j) < concentrationArray(k) Then
    sortedArray = concentrationArray(j)
    concentrationArray(j) = concentrationArray(k)
    concentrationArray(k) = sortedArray           
   End If
  Next k
 Next j
ElseIf sorting = False Then
 For j = LBound(concentrationArray) To UBound(concentrationArray)
  For k = j + 1 To UBound(concentrationArray)
   If concentrationArray(j) > concentrationArray(k) Then
    sortedArray = concentrationArray(k)
    concentrationArray(k) = concentrationArray(j)
    concentrationArray(j) = sortedArray
   End If
  Next k
 Next j
End If

However, from these sorted array, they may contain repeated values which I want to remove them.

For j = LBound(concentrationArray) To UBound(concentrationArray)
 For k = j + 1 To UBound(concentrationArray)
  If concentrationArray(j) <> concentrationArray(k) Then
   sortedArray = concentrationArray(j)
   concentrationArray(j) = concentrationArray(k)
   concentrationArray(k) = sortedArray
  ElseIf concentrationArray(j) = concentrationArray(k) Then
   sortedArray = concentrationArray(j)
   concentrationArray(j) = concentrationArray(k + 1)
   ReDim concentrationArray(LBound(concentrationArray) To UBound(concentrationArray) - 1) As Variant
   concentrationArray(k) = sortedArray
  End If
 Next k
Next j

I don't understand why this returns error.

Can anyone help?

Thanks in advance

--------------------------SOLVED--------------------------

Here it is another way to make it work:

j = LBound(concentrationArray)

While j < UBound(concentrationArray)
 If concentrationArray(j) = concentrationArray(j+1) Then
  Call DeleteElementArray(j, concentrationArray)
 End If
 j = j + 1
Wend

Public Sub DeleteElementArray(ByVal arrIndex as Integer, ByRef myArr as Variant)
Dim p as Long

 For p = arrIndex+1 To Ubound(myArr)
  myArr(p-1) = myArr(p)
 Next p

Use a non-sort-in-place algorithm, and simply don't add the duplicates to the sort output... — Comintern
– Comintern, Commented Sep 10, 2018 at 21:42
Nah, comintern’s idea is better - just remove the duplicates during the sort instead — Marcucciboy2
– Marcucciboy2, Commented Sep 10, 2018 at 21:46

Ibo · Accepted Answer · 2018-09-10 21:47:54Z

1

Use this simple trick to make a 1D array unique:

Function Unique(aFirstArray() As Variant)
'Collections can be unique, as long as you use the second Key argument when adding items.
'Key values must always be unique, and adding an item with an existing Key raises an error:
'hence the On Error Resume Next

    Dim coll As New Collection, a
    Dim tempArray() As Variant  'aFirstArray(),
    Dim i As Long

'    aFirstArray() = Array("Banana", "Apple", "Orange", "Tomato", "Apple", _
'    "Lemon", "Lime", "Lime", "Apple")

    On Error Resume Next
    For Each a In aFirstArray
       'Debug.Print a
       coll.Add a, a
    Next

    ReDim aFirstArray(coll.count)

    For i = 1 To coll.count
       'Cells(i, 1) = coll(i)
       aFirstArray(i) = coll(i)
    Next

End Function

answered Sep 10, 2018 at 21:47

Ibo

4,3197 gold badges51 silver badges75 bronze badges

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

Comments

QHarr · Accepted Answer · 2018-09-11 07:40:57Z

As your data is already sorted you could also use an ArrayList object and then extract all items in one go with .toArray. You can use .Contains method to add only unique items.

Option Explicit
Public Sub DeDuplicateArray()
    Dim sortedArray(), i As Long, sList As Object, arr()
    sortedArray = Array(0, 0, 1, 2, 2, 3)
    Set sList = CreateObject("System.Collections.ArrayList")
    For i = LBound(sortedArray) To UBound(sortedArray)
        If Not sList.contains(sortedArray(i)) Then sList.Add sortedArray(i)
    Next
    arr = sList.toArray
    Debug.Print UBound(arr)
End Sub

If data wasn't sorted you could add to a SortedList object, using a test of .Contains to exclude duplicates.

Option Explicit
Public Sub DeDuplicateArray()
    Dim sortedArray(), i As Long, sList As Object
    sortedArray = Array(0, 0, 1, 2, 2, 3)
    Set sList = CreateObject("System.Collections.SortedList")
    For i = LBound(sortedArray) To UBound(sortedArray)
        If Not sList.contains(sortedArray(i)) Then sList.Add sortedArray(i), vbNullString
    Next
    Debug.Print sList.Count
End Sub

hornetbzz · Accepted Answer · 2022-12-15 11:11:13Z

try this code please:

    Option Explicit

Sub ifDublicate()
Dim i, lRow As Integer
Dim actuellCell, cellInArray As Variant
Dim countValues, deleted As Double

'Dim arr ()
'lRow = ActiveSheet.Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
'arr = Range("A1:A" & lRow)

Dim arr(10) As Variant ' or array from worksheet
   arr(0) = "Apple"
   arr(1) = "Orange"
   arr(2) = "Apple"
   arr(3) = "Apple"
   arr(4) = "beans"
   arr(5) = "beans"
   arr(6) = "Orange"
   arr(7) = "Orange"
   arr(8) = "sandwitch"
   arr(9) = "coffee"
   arr(10) = "nuts"

For i = 0 To UBound(arr)
    actuellCell = arr(i)
    If InStr(cellInArray, actuellCell) > 0 Then
'        ActiveSheet.Cells(i, 2) = "Already Exists"
        deleted = deleted + 1
    Else
        cellInArray = CStr(cellInArray) & "," & CStr(actuellCell)
        countValues = countValues + 1
        If Left(cellInArray, 1) = "," Then
            cellInArray = Right(cellInArray, Len(cellInArray) - 1)
        End If
    End If
        
Next i

MsgBox "Array after remove duplicate: " & cellInArray & vbNewLine & _
        "Count Values without duplicate: " & countValues & vbNewLine & _
        "deleted: " & deleted & vbNewLine & _
        "last value: " & actuellCell

End Sub

Collectives™ on Stack Overflow

VBA - Remove duplicate values of an array

3 Answers 3

Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related