Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How can I paste a unique values list? | Excel Discussion (Misc queries) | |||
COPY PASTE VALUES ONLY FROM/ON VISIBLE CELLS | Excel Discussion (Misc queries) | |||
Compare and copy unique values | Excel Worksheet Functions | |||
copy only unique values | Excel Worksheet Functions | |||
Copy/Paste how to avoid the copy of formula cells w/o calc values | Excel Discussion (Misc queries) |