Get unique list of strings

[kapilrakh]

Hi,

I have 2 arrays of strings.

Dim str1(1 to 10), str2(1 to 10) as String

I get str1 filled up using external program. I am filling up those here manually.

str(1)="Laptop"
str(2)="MP3 Player"
str(3)="MP3 Player"
str(4)="Ipod"
str(5)="Ipod"
str(6)="Ipod"
str(7)="Ipod"
str(8)="GPS"
str(9)="TV"
str(10)=""

The aim of the program is to get unique names.
Hence the output will be.

str2(1)="Laptop"
str2(2)="MP3 Player"
str2(3)="Ipod"
str2(4)="GPS"
str2(5)="TV"
str2(6)=""
str2(7)=""
str2(8)=""
str2(9)=""
str2(10)=""

It will be also great to minimize the no. of comparisons as I am dealing with strings of quite a good length.

[shg]

Use one array of strings, sort, and delete duplicates?

[Leith Ross]

Hello kapilrakh,

This macro will print the your list of unique strings in a single column on a worksheet and sort them in ascending order.

Sub ListUniques(Where As Range, ByVal StrArray As Variant)

  Dim MyList As Object
  Dim Str As Variant
  
    Set MyList = CreateObject("Scripting.Dictionary")
    MyList.CompareMode = vbTextCompare
    
      For Each Str In StrArray
        If Str <> "" Then
          If Not MyList.Exists(Str) Then MyList.Add Str, 1
        End If
      Next Str
      
      Set Where = Where.Resize(RowSize:=MyList.Count)
      Where = WorksheetFunction.Transpose(MyList.Keys)
      
      Where.Sort Key1:=Where.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
                 MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    Set MyList = Nothing
      
End Sub

Example of Using the Macro
This will copy the list to the Active Sheet. Starting in Cell "A1".

    ListUniques Range("A1"), Str1

[lecxe]

Hi kapilrakh

If you have excel 2007 an easy way to do it is to use an auxilliary range and the Range method RemoveDuplicates.

Ex.: using column A in the active sheet as auxilliary:

Function RemoveDups(str1)

With Range("A1").Resize(UBound(str1))
    .Value = Application.Transpose(str1)
    .RemoveDuplicates Columns:=1, Header:=xlNo
    RemoveDups = Application.Transpose(.Value)
End With
End Function

This funcion receives an array of strings and returns an array with the same size but without duplicates.

Notice that you don't have to worry with any algorithm.

Let's test it with the example you posted:

Sub a()
Dim str1(1 To 10), str2

str1(1) = "Laptop"
str1(2) = "MP3 Player"
str1(3) = "MP3 Player"
str1(4) = "Ipod"
str1(5) = "Ipod"
str1(6) = "Ipod"
str1(7) = "Ipod"
str1(8) = "GPS"
str1(9) = "TV"
str1(10) = ""

str2 = RemoveDups(str1)
MsgBox Join(str2, ", ")
End Sub

Remark: I assumed the array index starts at 1.