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
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
Bookmarks