ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   sort data in a single cell? (https://www.excelbanter.com/excel-programming/296908-sort-data-single-cell.html)

todd

sort data in a single cell?
 
I have a set of terms that are entered into a single
cell. They are sperated by commas. I want to remove the
duplicates (there are several) and alpha-sort them. Is
there a way to do this in a single cell or do I have to
put each term in its own cell to do that?

Thanks


Todd

Tom Ogilvy

sort data in a single cell?
 
How are they arranged in the cell. Separated by commas?

You can modify John Walkenbach's code at

http://j-walk.com/ss/excel/tips/tip47.htm
Filling a ListBox With Unique Items

first you would need to get your list of items into an array. If using
xl2000 or later, you can use the split command

Modifying John's AllCells variable:

Dim AllCells as Variant, cell as Variant

AllCells = split(Worksheets("Sheet2").Range("B9"),",")

On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell, CStr(Cell)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell


=====
To illustrate:

Sub tester9()
Dim allcells As Variant, cell As Variant

allcells = Split("a,b,c,d,e,f,g", ",")
For Each cell In allcells
MsgBox cell
Next
End Sub

--
Regards,
Tom Ogilvy



"Todd" wrote in message
...
I have a set of terms that are entered into a single
cell. They are sperated by commas. I want to remove the
duplicates (there are several) and alpha-sort them. Is
there a way to do this in a single cell or do I have to
put each term in its own cell to do that?

Thanks


Todd




losmac[_2_]

sort data in a single cell?
 
Option Explici

Sub SortAndRemoveDuplicatesInSingleCell(
Dim strCellValue As Strin
Dim strArgs() As Strin
Dim i As Long, pos As Long, prevpos As Lon
Dim strTemp As Strin
Const strComma As String = ",
strCellValue = ActiveCel

If Right(strCellValue, 1) < strComma Then strCellValue = strCellValue & strComm

D
prevpos = pos +
pos = InStr(pos + 1, strCellValue, strComma
If pos 0 The
strTemp = Mid(strCellValue, prevpos, pos - prevpos
'MsgBox strTem
ReDim Preserve strArgs(i
strArgs(i) = strTem
i = i +
Els
Exit D
End I
Loo

SortInSingleCell strArgs(
'For i = LBound(strArgs()) To UBound(strArgs()
' MsgBox strArgs(i), , "Sorted List, element " &
'Next

strCellValue = "

RemoveDuplicates strArgs(
For i = LBound(strArgs()) To UBound(strArgs()
If strArgs(i) < vbNullChar The
strCellValue = strCellValue & strArgs(i) & strComm
'MsgBox strArgs(i), , "NoDuplicates List, element " &
End I
Next

MsgBox strCellValue, , "After sorting and removing duplicates...
'ActiveCell = strCellValu

End Su

Sub RemoveDuplicates(ByRef sortedList() As String
Dim i As Long, j As Long, k As Lon
Dim lb As Long, ub As Lon
Dim strTemp As Strin

'I use StrComp() function to sort any values (numeric or string
'B and b are different value
'Function StrComp() return values
'string1 is less than string2 -
'string1 is equal to string2
'string1 is greater than string2
'string1 or string2 is Null Nul

lb = LBound(sortedList()
ub = UBound(sortedList()

For i = ub To lb Step -
For j = i - 1 To lb Step -
If StrComp(sortedList(i), sortedList(j), vbBinaryCompare) = 0 The
sortedList(i) = vbNullChar 'replace string with vbNullCha
i = i - 1 'jump to next elemen
'we can't change size for sortedLis
'so, we make changes on it's element
End I
Next
Next
End Su

Sub SortInSingleCell(ByRef unsortedList() As String
Dim i As Long, j As Lon
Dim lb As Long, ub As Lon
Dim strTemp As Strin

'I use StrComp() function to sort any values (numeric or string
'B and b are different value
'Function StrComp() return values
'string1 is less than string2 -
'string1 is equal to string2
'string1 is greater than string2
'string1 or string2 is Null Nul

lb = LBound(unsortedList()
ub = UBound(unsortedList()

For i = lb To u
For j = i + 1 To u
If StrComp(unsortedList(i), unsortedList(j), vbBinaryCompare) = 1 The
strTemp = unsortedList(i
unsortedList(i) = unsortedList(j
unsortedList(j) = strTem
End I
Next
Next

End Su




All times are GMT +1. The time now is 07:31 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com