Remove duplicates and sort array

Hi,

I have a one dimensional array and I want to remove all duplicates from the array so that each value in the array is unique. Then I need to sort all the 'unique' values in the array. What is the most efficient way to accomplish these tasks?

Thanks.

abousetta

Hi,

Probably the simplest way is to use Data Filter Advanced Unique and copy to another range.
Then sort the unique range.
Delete your original array and cut and paste the unique range back to the top of the original array.

Regards
Regards

Hi Richard,

Sorry I should have been more clear about the source of my array. It is a string converted into an array, actually two strings.

  ' Create arrays from strings
    Arr1 = Split(S1, " ")
    Arr2 = Split(S2, " ")

  ' Create one (common) array from the two arrays
    Arr3 = Split(Join(Arr1, "|") & "|" & Join(Arr2, "|"), "|")
    
  ' Remove duplicates from arrays
  '*
  '*
  '* Not coded yet
  '*
  '*
  '*

What I am doing is comparing the two strings for similarities but there is no reason to go through repeated words since they will either be found or not.

abousetta

Hi,

Does Chip Pearson's article http://www.cpearson.com/excel/distinctvalues.aspx help.

I'm sure what you want is in there somewhere.

Hello Ahmed,

I think a better approach would to be to use a Dictionary object. You can easily create a 1-D array of unique values. You could also do this with a Collection object. I prefer the Dictionary object as you can test if an element already exists without generating an error. If you need help coding this, let me know.

Hi Leith,

Hope all is well. An example would be great. I know that you posted some examples a while back when we were both responding to another thread where the OP wanted to remove duplicates from a large list, but I can't find the link to it.

Thanks for all your help.

abousetta

Hello Ahmed,

Here is an example macro.

Sub RemoveDupes()

    Dim Dict As Object
    Dim Key As String
    Dim Keys As Variant
    
      ' Create arrays from strings
        Arr1 = Split(S1, " ")
        Arr2 = Split(S2, " ")

      ' Create one (common) array from the two arrays
        Arr3 = Split(Join(Arr1, "|") & "|" & Join(Arr2, "|"), "|")
    
      ' Remove duplicates from arrays
      
        Set Dict = CreateObject("Scripting.Dictionary")
        
          ' Comment the next line if you want the matches to be case sensitive.
            Dict.CompareMode = vbTextCompare
            
            For Each Key In Arr3
                Key = Trim(Key)
                If Key <> "" Then
                   If Not Dict.Exists(Key) Then Dict.Add Key, 1
                End If
            Next Key
            
       Erase Arr3
       Arr3 = Dict.Keys
    
End Sub

Perfect. Thanks Leith. I am trying to go the Array way these days (no pun intended). Arrays are said to be faster and more efficient and I am trying to learn to code using them but still learning the ropes.

abousetta

Hi Leith,

I had to just make one small change to your code (Key as Variant instead of String), but it works great. Thanks a lot for your help.

By any chance would you know how to solve the second half of the riddle (how to sort the array)? I am still searching but no obvious answer in sight.

abousetta

Sub snb()
  sn= Split(S1)
  sp= Split(S2)

  sn = Split(Join(sn) & " " & Join(sp))
  for j=0 to ubound(sn)
    if instr(c01 & "|","|" & sn(j) & "|")=0 then c01=c01 & "|" & sn(j)
  next

End Sub

Thanks snb. Unfortunately, I can't seem to get it to work. The array seems to be empty (or contains null values) because even the Msgbox is not showing me anything within the newly created sn array. I will keep testing it and hopefully get it going.

abousetta

Something has to be in S1 and S2.
If not than use:

Sub snb()
  sn= Split("aaaa sss ddd fff ggg hhh eee rrr")
  sp= Split("fff ggg hhh qwe wer erty rty")

  sn = Split(Join(sn) & " " & Join(sp))
  for j=0 to ubound(sn)
    if instr(c01 & "|","|" & sn(j) & "|")=0 then c01=c01 & "|" & sn(j)
  next
End Sub

Sorry. Now I know what I was doing wrong. c01 is a string. Therefore I needed to convert it back to an array to see the elements of the array.

I am going to mark this thread as solved for now and work on trying to sort the elements within the array.

Thanks everyone.

abousetta

and now the sorting part: resulting in a sorted array 'sp'

Sub snb()
  sn= Split("aaaa sss ddd fff ggg hhh eee rrr")
  sp= Split("fff ggg hhh qwe wer erty rty")

  sn = Split(Join(sn) & " " & Join(sp))
  for j=0 to ubound(sn)
    if instr(c01 & "|","|" & sn(j) & "|")=0 then c01=c01 & "|" & sn(j)
  next

  sn = Split(c01, "|")
  sp = Split(sn(0))
  c02 = sn(0)
    
  For j = 1 To UBound(sn)
   For jj = 0 To UBound(sp)
    If sn(j) < sp(jj) Then
     c02 = Replace(c02, sp(jj), sn(j) & "_" & sp(jj))
     Exit For
    End If
   Next
   If jj = UBound(sp) + 1 Then c02 = c02 & "_" & sn(j)
   sp = Split(c02, "_")
  Next
end sub

Thanks snb. As usual, I will need a big mug of coffee to try and decipher the advanced coding techniques, but I can always say that I am gaining a great amount of experience studying your approaches.

abousetta

This does both in one routine

Sub test()
    Dim delimitedString As String, Delimiter As String
    Dim AlteredString As String
    Dim SortedArrayOfNonDuplicates As Variant
    
    Delimiter = "|"
    delimitedString = "a|x|b|b|a|c|c|d|a|x|a|a"
    
    AlteredString = SortString(delimitedString, Delimiter)
    MsgBox AlteredString:  ' a|b|c|d|x
    
    SortedArrayOfNonDuplicates = Split(AlteredString, Delimiter)
End Sub

Function SortString(delimitedString As String, Optional Delimiter As String = " ")
    Dim strLeft As String, strRight As String
    Dim subStrings As Variant, oneSub As Variant
    Dim Pivot As String
    
    subStrings = Split(delimitedString, Delimiter)
    Pivot = subStrings(0)
    For Each oneSub In subStrings
        If oneSub < Pivot Then
            strLeft = strLeft & Delimiter & oneSub
        ElseIf Pivot < oneSub Then
            strRight = strRight & Delimiter & oneSub
        End If
    Next oneSub
    strLeft = Mid(strLeft, 2): strRight = Mid(strRight, 2)
    
    SortString = Pivot
    If strLeft <> vbNullString Then
        SortString = SortString(strLeft, Delimiter) & Delimiter & SortString
    End If
    If strRight <> vbNullString Then
        SortString = SortString & Delimiter & SortString(strRight, Delimiter)
    End If
End Function

I have modified the code that snb provided to compensate for the nature of the data, but have one final problem that I can't figure out.

      ' Remove duplicates from array
        For i = 0 To UBound(CitationArray)
            If InStr(NewString & "|", "|" & CitationArray(i) & "|") = 0 Then NewString = NewString & "|" & CitationArray(i)
        Next
        
      ' Remove first (empty) element from Array
        CitationArray = Split(NewString, "|")
        NewCitationArray = Split(CitationArray(0))
        EmptyString = CitationArray(0)
      
      ' Arrange elements in Array in alpaha-numeric order
        For A1 = 1 To UBound(CitationArray)
            For A2 = 0 To UBound(NewCitationArray)
                If Len(EmptyString) = 0 Then EmptyString = CitationArray(A1)
                If CitationArray(A1) < NewCitationArray(A2) Then
                    EmptyString = Replace(EmptyString, "_" & NewCitationArray(A2), "_" & CitationArray(A1) & "_" & NewCitationArray(A2))
                    Exit For
                End If
            Next
            If A2 = UBound(NewCitationArray) + 1 Then EmptyString = EmptyString & "_" & CitationArray(A1)
            NewCitationArray = Split(EmptyString, "_")
        Next

Now this works fine on small passages (a couple of sentences), but larger paragraphs the results are not accurate with some duplicates still being present and some out of alpha-numeric order. The weird thing is that when I rerun it again, it works just fine giving accurate results. For now I have put in a loop to go through the deduplicate and sort process twice, but this of course is inefficient.

Any thoughts?

abousetta

Thanks nilem. I will test tomorrow and post back. Just out of curiosity what's a ZVI function (never came across this term before).

If this is your goal:

' Remove first (empty) element from Array

you should use
CitationArray = Split(mid(NewString,2), "|")

If you provide the string you are testing with we can have a look too.

Thanks nilem. I am unfortunately a fish out of water when it comes to Excel .

In fact, I have heard of ZVI, but haven't ever studied his techniques... maybe its time to start.

snb, I have uploaded a sample of ten rows that show the problem. In the first sheet, I ran the code for deduping and sorting once, while in the second sheet, I ran the code twice. As you can see, the second returns 100% for all three columns since they are all identical. All the code I used is in the upload (didn't strip it down since the problem may be lying somewhere else in the code that I don't see).

Thanks.

abousetta

nilem, the code works great! It does the deduping and sorting at the same time. I'm impressed

Question though, what does the "&" sign after the variable mean?

Dim i&, s$, j&

Thanks again.

abousetta

Thanks nilem. I found this great thread and discussion between ZVI and pgc01. I am going to test the two three approaches (Instr, Dict, Collection). From what I have read, the resutls with the Dictionary approach should prove to be the fastest, but I want to see what the differences will be with my data sets.

Thanks again nilem and Mike. Mike's approach in itself is ingenious as it opens up a whole new approach that I had never thought of, which is having a function keep calling itself (looping) until it completes the task. I used to think this can only be accomplished by a sub calling a function with Do... Loop while approach and Public variables.

I'm going to mark this thread as solved for now and want to thank everyone for the wealth of knowledge in this discussion.

abousetta

Originally Posted by abousetta

Thanks again nilem and Mike. Mike's approach in itself is ingenious as it opens up a whole new approach that I had never thought of, which is having a function keep calling itself (looping) until it completes the task. I used to think this can only be accomplished by a sub calling a function with Do... Loop while approach and Public variables.

I'm going to mark this thread as solved for now and want to thank everyone for the wealth of knowledge in this discussion.

abousetta

A function that calls itself is called a "recursive function".

Thanks Mike. I currently remove duplicates with the scripting dictionary and then sort using one of the standard vb methods (e.g. bubble sort, etc.).

Why not use one object to sort and remove duplicates? Consider:

Sub kyle()
Dim a, s
a = Array("sdf", "234", "sfdf", "sdf", "123")
s = UniqueSort(a, True)
End Sub

Public Function UniqueSort(arr As Variant, Optional SortDesc As Boolean) As Variant
Dim x As Long
    With CreateObject("system.collections.arraylist")
        For x = LBound(arr) To UBound(arr)
            If Not .contains(CStr(arr(x))) Then .Add arr(x)
        Next x
        .Sort
        If SortDesc Then .Reverse
        UniqueSort = .toarray
    End With
End Function