View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
jindon[_3_] jindon[_3_] is offline
external usenet poster
 
Posts: 1
Default Copy & Paste Unique Cells Values


Michael168,

My misunderstanding.

I thought the numbers are in "ONE CELL", so code in the previous post
doen't work for you.

The following code should work.
Before you run the code, you need to select the range in question.
e.g. G9:L14


Code:
--------------------

Sub test()
Dim rng As Range, i As Long, ii As Integer, a, dic As Object, x
Set dic = CreateObject("Scripting.Dictionary")
Set rng = Selection
With rng
rw = .Rows.Count: col = .Columns.Count
For i = 1 To rw
For ii = 1 To col
If Not IsEmpty(.Cells(i, ii)) And Not dic.exists(.Cells(i, ii).Value) Then
dic.Add .Cells(i, ii).Value, Nothing
End If
Next
x = dic.keys: ReDim Preserve x(1 To dic.Count)
x = QuickSort(x, LBound(x), UBound(x))
.Cells(i, col).Offset(, 1).Resize(, UBound(x)).Value = x
a = dic.RemoveAll: Erase x
Next
End With
End Sub

Function QuickSort(Ary, SideA As Integer, SideB As Integer)
Dim i As Integer, ii As Integer
Dim m As Long, tmp As Long
i = SideA
ii = SideB
m = Ary(Int((SideB + SideA) / 2))
Do While i <= ii
Do While Ary(i) < m
i = i + 1
Loop
Do While m < Ary(ii)
ii = ii - 1
Loop
If i <= ii Then
tmp = Ary(i)
Ary(i) = Ary(ii)
Ary(ii) = tmp
i = i + 1
ii = ii - 1
End If
Loop
If SideA < ii Then QuickSort = QuickSort(Ary, SideA, ii)
If i < SideB Then QuickSort = QuickSort(Ary, i, SideB)
QuickSort = Ary
End Function

--------------------


--
jindon
------------------------------------------------------------------------
jindon's Profile: http://www.excelforum.com/member.php...o&userid=13135
View this thread: http://www.excelforum.com/showthread...hreadid=375538