CODEWITHSUNDEEP
arraysvbasortingduplicates
codeLearner
codeLearner

Reputation: 86

VBA - Remove duplicate values of an array

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

Upvotes: 0

Views: 2839

Answers (3)

Suliman Farzat
Suliman Farzat

Reputation: 1260

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

Upvotes: 0

QHarr
QHarr

Reputation: 84465

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

Upvotes: 1

Ibo
Ibo

Reputation: 4309

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

Upvotes: 1

Related Questions