VBA Removing duplicates in an array

Question

I have a string that looks like "apples//apples//oranges//" I'm getting an error "subscript out of range" when I try to remove duplicates.

I want my end result to look like "apples//oranges//"

Dim duplicateArray() As String
Dim programsArray() As String

duplicateArray() = Split(Sheets("Sheet1").Cells(1, 12).Value, "//")

For j = 0 To UBound(duplicateArray)
    If UBound(Filter(programsArray, duplicateArray(j))) > -1 Then

    Else
    programsArray(UBound(programsArray()) + 1) = duplicateArray(j)

    End If

Next j

    programElement = Join(programsArray, " // ")
    Sheets("Sheet1").Cells(1, 3).Value = programElement

sorry, it should be Sheets("Sheet1").Cells(1, 3).Value = programElement — user3757739, Jun 19 '14 at 19:03
I want programsArray to by a dynamic array. How do you define it so that I can add new text to it? — user3757739, Jun 19 '14 at 19:04
You're getting "subscript out of range" in your code becuase you haven't dimensioned `programsArray` - you need to give that a size before you add anything to it... However, `Filter` isn't really a safe way to extract unique array elements, since it matches on *substrings* - if any one of your elements is a substring of any other element you won't get what you expect. Maybe try a dictionary? — Tim Williams, Jun 19 '14 at 19:09
@user3757739 to dynamicaly resize an array use `Redim` See my answer applied in your code — Horaciux, Jun 19 '14 at 19:13

score 1 · Answer 1 · answered Jun 19 '14 at 19:05

To dynamicaly resize an array:

ReDim [ Preserve ] name(boundlist)

Use Preserve to keept previous data stored in array

Dim duplicateArray() As String
Dim programsArray() As String

duplicateArray() = Split(Sheets("Sheet1").Cells(1, 12).Value, "//")

For j = 0 To UBound(duplicateArray)
    If UBound(Filter(programsArray, duplicateArray(j))) > -1 Then

    Else
    redim preserve programsArray(UBound(programsArray()) + 2)
    programsArray(UBound(programsArray()) + 1) = duplicateArray(j)

    End If

Next j

    programElement = Join(programsArray, " // ")
    Sheets("Sheet1").Cells(1, 3).Value = programElement

I am still getting the error "subscript out of range" It seems to be from "If UBound(Filter(programsArray, duplicateArray(j))) > -1 Then" — user3757739, Jun 19 '14 at 19:14

score 0 · Answer 2 · answered Jun 19 '14 at 19:11

Consider:

Sub DeDup()
    duplicateArray = Split(Sheets("Sheet1").Cells(1, 12).Value, "//")
    Dim c As Collection
    Set c = New Collection
    On Error Resume Next

    For Each d In duplicateArray
        c.Add d, CStr(d)
    Next d

    programsArray = c(1)
    For i = 2 To c.Count
        programsArray = programsArray & "//" & c(i)
    Next i

    Sheets("Sheet1").Cells(1, 3).Value = programsArray
End Sub

VBA Removing duplicates in an array

2 Answers2