LinkBack URL
About LinkBacks
Is there a way to sort a lot of names in word wrap cell and paste the names into multiple cells one name at a time?
Is there a way to sort a lot of names in word wrap cell and paste the names into multiple cells one name at a time?
Last edited by zplugger; 09-25-2012 at 09:29 AM.
There sure is. Use the Text-to-Columns feature and chose delimited and select commas as your divider. That should do it.
Getting Destination Reference is not valid
My best guess is that Excel will not let you use text to columns to a different sheet. Try it again but select the active sheet as the destination. Then you can copy that over to a new sheet, only way to work around it.
Not sure this can be done, I want all the names in one column?
Here's a macro that will work
Sub abc() Dim i As Long, ii As Long, iii As Long Dim x, y With CreateObject("system.collections.arraylist") For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row x = Split(Cells(i, "a"), vbCr) For ii = LBound(x) To UBound(x) y = Split(x(ii), ",") For iii = LBound(y) To UBound(y) .Add CStr(y(iii)) Next Next Next .Sort x = WorksheetFunction.Transpose(.toarray) Worksheets.Add After:=Worksheets(Worksheets.Count) Range("a1").Resize(UBound(x)) = x End With End Sub
Thanks,
Mike
If you are satisfied with the solution(s) provided, please mark your thread as Solved.
Select Thread Tools-> Mark thread as Solved.
WoW that is close, but it add a sheet everytime I run it. Can I keep it on a single sheet. When I add it will just go to the next empty cell in row a?
Try this
Sub abc() Const shDest As String = "Sheet2" '<====== Name of the sheet to add the names to. Change to your needs Dim i As Long, ii As Long, iii As Long, Lastrow As Long Dim x, y With CreateObject("system.collections.arraylist") For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row x = Split(Cells(i, "a"), vbCr) For ii = LBound(x) To UBound(x) y = Split(x(ii), ",") For iii = LBound(y) To UBound(y) .Add CStr(y(iii)) Next Next Next .Sort x = WorksheetFunction.Transpose(.toarray) End With With Worksheets(shDest) Lastrow = .Cells(Rows.Count, "a").End(xlUp).Row + 1 .Range("a" & Lastrow).Resize(UBound(x)) = x End With End Sub
Thank You, that is outstanding code work.
Update to post#8 added trim function. If names had leading or trailing spaces, sort would not work correctly.
Sub abc() Const shDest As String = "Sheet2" '<====== Name of the sheet to add the names to. Change to your needs Dim i As Long, ii As Long, iii As Long, Lastrow As Long Dim x, y With CreateObject("system.collections.arraylist") For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row x = Split(Cells(i, "a"), vbCr) For ii = LBound(x) To UBound(x) y = Split(x(ii), ",") For iii = LBound(y) To UBound(y) .Add CStr(Trim(y(iii))) Next Next Next .Sort x = WorksheetFunction.Transpose(.toarray) End With With Worksheets(shDest) Lastrow = .Cells(Rows.Count, "a").End(xlUp).Row + 1 .Range("a" & Lastrow).Resize(UBound(x)) = x End With End Sub
Ran into a small problem, on sheet 2 some of the names in yellow will not sort? Remove Diplicates does not see them at all?
Z
Try this
Sub Macro1() Const shDest As String = "Sheet2" '<====== Name of the sheet to add the names to. Change to your needs Dim i As Long, ii As Long, iii As Long, Lastrow As Long Dim x, y With CreateObject("system.collections.arraylist") For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row x = Split(Cells(i, "a"), vbCr) For ii = LBound(x) To UBound(x) y = Split(x(ii), ",") For iii = LBound(y) To UBound(y) y(iii) = Replace(y(iii), "Cast: ", "") y(iii) = Replace(y(iii), "Cast:", "") y(iii) = Replace(y(iii), "Director: ", "") y(iii) = Replace(y(iii), "Director:", "") y(iii) = CStr(Trim(y(iii))) .Add CStr(Trim(y(iii))) Next Next Next .Sort x = WorksheetFunction.Transpose(.toarray) End With With Worksheets(shDest) Lastrow = .Cells(Rows.Count, "a").End(xlUp).Row + 1 .Range("a" & Lastrow).Resize(UBound(x)) = x .Columns("A:A").Range("$A$1:$A$" & CLng(UBound(x))).RemoveDuplicates Columns:=1, Header:=xlNo End With End Sub
Last edited by mike7952; 09-25-2012 at 09:13 AM.
Thanks Mike, now I'm getting Cast: again. Is this right?
Const shDest As String = "Sheet2" '<====== Name of the sheet to add the names to. Change to your needs Dim i As Long, ii As Long, iii As Long, Lastrow As Long Dim x, y With CreateObject("system.collections.arraylist") For i = 1 To Cells(Rows.Count, "e").End(xlUp).Row x = Split(Cells(i, "e"), vbCr) For ii = LBound(x) To UBound(x) y = Split(x(ii), ",") For iii = LBound(y) To UBound(y) y(iii) = Replace(Trim(y(iii)), "Cast: ", "") y(iii) = CStr(Trim(y(iii))) .Add CStr(y(iii)) Next Next Next .Sort x = WorksheetFunction.Transpose(.toarray) End With With Worksheets(shDest) Lastrow = .Cells(Rows.Count, "a").End(xlUp).Row + 1 .Range("a" & Lastrow).Resize(UBound(x)) = x End With
Try the code in post #12
That did it, works like a champ. Speaking of champs that macro you wrote make you a Champ in my book.
Z
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks