Re: Alphabetical Sort Of Data Within A Cell

Hello dsutton!

I always enjoy a good challenge when I find one...

I've tested this, and it seems to work...

Obviously it's considering only cell A12 like you mentionned in your example. Therefore you will need to slightly adapt the code to cycle through all 12000 entries...

```
Sub StoreData()
Dim sString As String
Dim sTemp As String
Dim iNoCommas As Integer
sString = Range("A12").Value
' Evaluate where the commas are positioned
' in order to transfer all entries in the
' string within array
For i = 1 To Len(sString)
sTemp = Mid(sString, i, 1)
If sTemp Like "," Then
iNoCommas = iNoCommas + 1
End If
Next i
' Update information in cell A12
Range("A12").Value = SortArray(sString, iNoCommas)
End Sub
Function SortArray(sStr As String, iNoCom As Integer) As String
Dim sStringConv As String
ReDim aCommas(iNoCom) As Integer
ReDim aString(iNoCom) As String
' Strip all spaces from sStr
For i = 1 To Len(sStr)
sTemp = Mid(sStr, i, 1)
If Not sTemp Like "[ ]" Then
sBuff = sBuff & sTemp
End If
Next i
sStr = sBuff
' Store start and each comma position to aCommas
For i = 1 To Len(sStr)
sTemp = Mid(sStr, i, 1)
If i = 1 Then aCommas(i - 1) = 1
If sTemp Like "," Then
j = j + 1
aCommas(j) = i
End If
Next i
' Strip and store each words of sString to aString (While stripping the commas)
For i = 0 To iNoCom - 1
sBuff = vbNullString
aString(i) = Mid(sStr, aCommas(i), (aCommas(i + 1) - aCommas(i)))
For j = 1 To Len(aString(i))
sTemp = Mid(aString(i), j, 1)
If Not sTemp Like "[,]" Then
sBuff = sBuff & sTemp
End If
Next j
aString(i) = sBuff
Next i
' Store last entry of sStr to aString
aString(iNoCom) = Mid(sStr, aCommas(iNoCom), (Len(sStr) - aCommas(iNoCom) + 1))
sBuff = vbNullString
For j = 1 To Len(aString(iNoCom))
sTemp = Mid(aString(iNoCom), j, 1)
If Not sTemp Like "[,]" Then
sBuff = sBuff & sTemp
End If
Next j
aString(iNoCom) = sBuff
'Sort aString
For i = 0 To UBound(aString)
For j = i To UBound(aString)
If UCase(aString(j)) < UCase(aString(i)) Then
str1 = aString(i)
str2 = aString(j)
aString(i) = str2
aString(j) = str1
End If
Next j
Next i
' Build converted string
For i = 0 To UBound(aString)
sStringConv = sStringConv & aString(i)
If i < UBound(aString) Then sStringConv = sStringConv & ", "
Next i
SortArray = sStringConv
End Function
```

Display More

Hope this works for you...