Need Help for my CAREER!

[garyc]

de-duplicating a list of string in array , and put it in alphabetical order.

For example,
David, Carmen, Adam, David, Ben, Ben, Adam
---->
Adam, Ben, Carmen, David


Solving this Case is real important for me. If any smart guy can solve it, I will really appreciate it as he save someone's career.

[Bob Phillips]

[vba]

Sub DedupArray()
Dim ary As Variant
Dim col As Collection
Dim i As Long

ary = Array("David", "Carmen", "Adam", "David", "Ben", "Ben", "Adam")
Set col = New Collection
On Error Resume Next
For i = LBound(ary) To UBound(ary)

col.Add ary(i), ary(i)
Next i
On Error GoTo 0
ReDim ary(1 To col.Count)
For i = 1 To col.Count

ary(i) = col.Item(i)
Next i

End Sub
[/vba]

[david000]

Same as 'xld', but another superb example from:

http://www.dailydoseofexcel.com/arch...elected-cells/



[vba]

Sub GetUniqueList()

Dim rCell As Range
Dim colUnique As Collection
Dim sh As Worksheet
Dim i As Long

'only work on ranges
If TypeName(Selection) = "Range" Then

'create a new collection
Set colUnique = New Collection

'loop through all selected cells
'and add to collection
For Each rCell In Selection.Cells
On Error Resume Next
'if value exists, it won't be added
colUnique.Add rCell.Value, CStr(rCell.Value)
On Error GoTo 0
Next rCell

'make a new sheet to put the unique list
Set sh = ActiveWorkbook.Worksheets.Add

'Write the unique list to the new sheet
For i = 1 To colUnique.Count
sh.Range("A1").Offset(i, 0).Value = colUnique(i)
Next i

'sort with no headers
sh.Range(sh.Range("A2"), sh.Range("A2").End(xlDown)) _
.Sort sh.Range("A2"), xlAscending, , , , , , xlNo

End If

End Sub



[/vba]

[Kenneth Hobs]

The classic way to remove duplicates in an array would be by collection as demonstrated by xls and David or the similar dictionary method. To sort, one can use an array sort or the Range method as David posted.

If I were doing it just for an array excercise, I would use an array sort method. If it were for a range, I would probably use an advanced filter to remove duplicates and then sort by Range method.

[mikerickson]

You can sort as you are adding to the collection.
[VBA]Dim myArray As Variant
Dim oneName As Variant
Dim myColl As Collection
Dim i As Long
myArray = Array("David", "John", "Bob", "Carol", "John", "Bob")

Set myColl = New Collection
myColl.Add Item:="DUMMY", key:="DUMMY"
On Error Resume Next
For Each oneName In myArray
For i = 1 To myColl.Count
If oneName < myColl(i) Then
myColl.Add Item:=oneName, key:=oneName, before:=i
End If
Next i
myColl.Add Item:=oneName, key:=oneName
Next oneName
On Error GoTo 0
myColl.Remove "DUMMY"

ReDim myArray(1 To myColl.Count)
For i = 1 To myColl.Count
myArray(i) = myColl(i)
Next i[/VBA]

[garyc]

Thanks! everyone.
But I am too green to understand the solutions.
Here are some question?
[vba] For Each rCell In Selection.Cells
On Error Resume Next
'if value exists, it won't be added
colUnique.Add rCell.Value, CStr(rCell.Value)
On Error Goto 0
Next rCell [/vba]

1) What is this pair of code for ? I have read the HELP and its examples but I still dun get it.
[vba]On Error Resume Next
On Error Goto 0 [/vba]
2) We have to add the item twice ? why repeat the rcell ? I have learnt Collection before. I am really confused. And I have read the HELP for a really long time but it seems beyond my capability. Can anyone explain briefly what is going on. Thanks !

[vba]colUnique.Add rCell.Value, CStr(rCell.Value)[/vba]

[Bob Phillips]

The OnError Resume Next is added to stop the coe failing when you add to the collection, as you (Might be) adding the same value to it twice, so you need to stop that error. The On Error Goto then resets the error handler.

You add the value twice, because a collection stores a key and an item value. As we are just using the collecton as staging mechanism, we don't care about separate values, so we set both to the array value.

[garyc]

Does that mean collection does not allow any duplicates?

[vba] On Error Resume Next
For i = LBound(ary) To UBound(ary)

col.Add ary(i), ary(i)
Next i
On Error GoTo 0[/vba]

Like this example offered by xld
When a same value is added to the collection, Error occur, then go to next.
Just like this ?

[Bob Phillips]

Yes, you cannot have duplicates in a collection.

[Kenneth Hobs]

Here is the dictionary method with a sort routine. I used early binding so set the reference or comment that part out and uncomment the late binding parts. Put the sort routine in its own module.

One could use the Exists property to determine whether to add the item to the dictionary or not. I just used the error method.

[vba]Option Explicit

Sub Test()
Dim anArray() As Variant, origArray() As Variant
origArray() = [{"David", "John", "Bob", "Carol", "John", "Bob"}]
anArray() = ArrayNoDups(origArray())
MsgBox Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(anArray)), vbCrLf)
MsgBox Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sort1dArray(an Array))), vbCrLf)
End Sub

Function ArrayNoDups(myArray() As Variant) As Variant
'Returns base 1 variant array
' myArray = Array("David", "John", "Bob", "Carol", "John", "Bob")
Dim oneName As Variant

'Early Binding Method. Requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Dim d As Dictionary
Set d = New Dictionary

'Late Binding method
'Dim d As Object
'Set d = CreateObject("Scripting.Dictionary")

On Error Resume Next
For Each oneName In myArray()
d.Add oneName, Nothing
Next oneName

myArray() = d.Keys
Set d = Nothing
ArrayNoDups = myArray()
End Function
[/vba]
Sort routine:
[vba]Option Explicit

Dim stack() As Long 'dual LIFO stacks
Dim stackPoint As Long
'Similar to MikeErickson's, http://www.excelforum.com/showthread.php?t=596061
Function Sort1dArray(inRRay() As Variant, Optional decendingSort As Boolean) As Variant
Dim low As Long, high As Long
Dim putHere As Long, I As Long
Dim pivotIndex As Long
Dim pivotVal As Variant
ReDim stack(1, 0)
Let stackPoint = 0

low = LBound(inRRay)
high = UBound(inRRay)

Call Push(low, high)

Do Until stackPoint < 1
'Pop( endpoints for partitioning )
Call Pop(low, high)

'sub-routine Partition (inRRay, low, high, pivotIndex)
Call swap(inRRay, high, (low + high) / 2)
Let pivotVal = inRRay(high)
putHere = low
For I = low To high - 1
'Here's the place to insert the custom .LT. function ******
'If LT(inRRay(i), pivotVal) Then
If (inRRay(I) < pivotVal) Xor decendingSort Then
Call swap(inRRay, I, putHere)
putHere = putHere + 1
End If
Next I
pivotIndex = putHere
Call swap(inRRay, high, pivotIndex)
'end partition routine

'Push( endpoints of unsorted streaches)
If low < pivotIndex - 1 Then Call Push(low, pivotIndex - 1)
If pivotIndex + 1 < high Then Call Push(pivotIndex + 1, high)
Loop
Sort1dArray = inRRay()
End Function

Private Sub Push(a As Long, Optional b As Long)
'dual LIFO stacks
If stackPoint = UBound(stack, 2) Then _
ReDim Preserve stack(0 To 1, stackPoint + 10)
stackPoint = stackPoint + 1
stack(0, stackPoint) = a
stack(1, stackPoint) = b
End Sub
Private Sub Pop(a As Long, Optional b As Long)
'dual LIFO stacks
a = stack(0, stackPoint)
b = stack(1, stackPoint)
stackPoint = stackPoint - 1
End Sub
Sub swap(inRRay As Variant, a As Long, b As Long)
Dim Temp As Variant
Temp = inRRay(a)
inRRay(a) = inRRay(b)
inRRay(b) = Temp
End Sub
Function LT(a As Variant, b As Variant) As Boolean
LT = False
If a < b Then LT = True
End Function
[/vba]

[david000]

Ken,
Regarding the assemblage of sort routines; are the two variable up top supposed to be declared Publicly?


[vba]
Dim stack() As Long 'dual LIFO stacks
Dim stackPoint As Long
[/vba]

[vba]
Public stack() As Long 'dual LIFO stacks
Public stackPoint As Long
[/vba]

[Kenneth Hobs]

Right, Public is fine or you can use Dim as Mike did in his original sort routine similar to that one. That is why I said put it in its own Module.

Of course you can put the ArrayNoDups() function in that same module too. This way, you can keep the functions all in one module. You can then add the Test routine or reference those functions from other Modules.

For kicks, here is a function method based on Mike's code where he used a collection and sorted in one routine.

[vba]Option Explicit

Sub Test()
Dim anArray() As Variant, origArray() As Variant
origArray() = [{"David", "John", "Bob", "Carol", "John", "Bob"}]
anArray() = ArrayNoDupsSort(origArray())
MsgBox Join(anArray, vbCrLf)
End Sub

'Similar to Mikerickson's, 'http://www.vbaexpress.com/forum/showthread.php?p=170551
Function ArrayNoDupsSort(myArray() As Variant) As Variant
' myArray = Array("David", "John", "Bob", "Carol", "John", "Bob")
Dim oneName As Variant
Dim myColl As Collection
Dim I As Long
Dim vArray() As Variant

Set myColl = New Collection
myColl.Add Item:="DUMMY", key:="DUMMY"
On Error Resume Next
For Each oneName In myArray
For I = 1 To myColl.Count
If oneName < myColl(I) Then
myColl.Add Item:=oneName, key:=oneName, before:=I
Else: myColl.Add Item:=oneName, key:=oneName
End If
Next I
Next oneName
On Error GoTo 0
myColl.Remove "DUMMY"

ReDim vArray(1 To myColl.Count)
For I = 1 To myColl.Count
vArray(I) = myColl(I)
Next I
Set myColl = Nothing
ArrayNoDupsSort = vArray()
End Function
[/vba]

[slamet Harto]

forgive me, just using formulas
pls find attched

Thanks & rgds, Harto