Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I paste a unique values list? jak roodi Excel Discussion (Misc queries) 14 April 22nd 23 08:10 AM
COPY PASTE VALUES ONLY FROM/ON VISIBLE CELLS FARAZ QURESHI Excel Discussion (Misc queries) 6 April 29th 09 01:32 PM
Compare and copy unique values sa02000 Excel Worksheet Functions 1 June 12th 06 09:42 PM
copy only unique values Sweetetc Excel Worksheet Functions 2 April 3rd 06 10:42 PM
Copy/Paste how to avoid the copy of formula cells w/o calc values Dennis Excel Discussion (Misc queries) 10 March 2nd 06 10:47 PM


All times are GMT +1. The time now is 02:55 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"