sort words, not in list, nor table

[geotso]

In a word document there are some (not always the same amount of) comma
separated words like:
test, more, active, problem, full, oil, year etc
and I want them sorted alphabetically, like:
active, full, more, oil, problem, test, year

For now, I use the following steps:

I Select the words and convert them to table
Then, I sort them
Finally I convert the table back to text

Is there a VBA script to simplify the process?

Thanks

 

[Steve Yandl]

Try the subroutine below. You would select the set of words you want sorted
and run the macro to replace with the same words but alphabetized.

'-------------------------------------------------

Sub AlphaCommaSepWords()

Const adVarChar = 200
Const MaxCharacters = 255

Dim strListOrig As String
Dim strTail As String
Dim strListFinal As String

strListOrig = Selection.Range.Text
If Len(strListOrig) < 1 Then
Exit Sub
End If
strTail = ""
strListFinal = ""

' Clean up any non alpha characters from tail end
' of the selection.
Do Until Asc(Right(strListOrig, 1)) > 64 And _
Asc(Right(strListOrig, 1)) < 91 Or _
Asc(Right(strListOrig, 1)) > 96 And _
Asc(Right(strListOrig, 1)) < 123
strTail = Right(strListOrig, 1) & strTail
strListOrig = Left(strListOrig, Len(strListOrig) - 1)
Loop

' Set up a disconnected recordset to sort
Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "WordList", adVarChar, MaxCharacters
DataList.Open

' Create array from comma separated words, add words to database
arrWords = Split(strListOrig, ",")
For W = 0 To UBound(arrWords)
DataList.AddNew
DataList("WordList") = Trim(arrWords(W))
DataList.Update
Next W

' Sort datalist and rebuild string with sorted words and commas
DataList.Sort = "WordList"

DataList.MoveFirst
Do Until DataList.EOF
strListFinal = strListFinal & _
DataList.Fields.Item("WordList") & ", "
DataList.MoveNext
Loop
strListFinal = Left(strListFinal, Len(strListFinal) - 2)
strListFinal = strListFinal & strTail

Selection.Range.Delete
Selection.TypeText strListFinal

Set DataList = Nothing

End Sub


'-------------------------------------------------

Steve Yandl

 

[geotso]

Steve,
Thank you very much for your help!

However, may I ask you for an improvement:
The "Do Until...Loop" section prevents me from ordering non-english words
(greeks are my native language).
Could you please help me with this?

Thanks again...

 

[Steve Yandl]

That loop and a few associated additional lines can be dropped and the
sorting routine will still work. You should just exercise some care when
you select the words to be sorted to avoid including punctuation marks at
the end, or hidden formatting marks (like a tab or new paragraph). I've
placed an amended version of the sub below.

'-------------------------------------

Sub AlphaCommaSepWords()

Const adVarChar = 200
Const MaxCharacters = 255

Dim strListOrig As String
Dim strListFinal As String

strListOrig = Selection.Range.Text
If Len(strListOrig) < 1 Then
Exit Sub
End If
strListFinal = ""


' Set up a disconnected recordset to sort
Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "WordList", adVarChar, MaxCharacters
DataList.Open

' Create array from comma separated words, add words to database
arrWords = Split(strListOrig, ",")
For W = 0 To UBound(arrWords)
DataList.AddNew
DataList("WordList") = Trim(arrWords(W))
DataList.Update
Next W

' Sort datalist and rebuild string with sorted words and commas
DataList.Sort = "WordList"

DataList.MoveFirst
Do Until DataList.EOF
strListFinal = strListFinal & _
DataList.Fields.Item("WordList") & ", "
DataList.MoveNext
Loop
strListFinal = Left(strListFinal, Len(strListFinal) - 2)

Selection.Range.Delete
Selection.TypeText strListFinal

Set DataList = Nothing

End Sub


'-------------------------------------

Steve Yandl

 

[geotso]

sorting routine will still work. You should just exercise some care when

you select the words to be sorted to avoid including punctuation marks at
the end, or hidden formatting marks (like a tab or new paragraph). I've

Yes... I understand that...

placed an amended version of the sub below.

That's much better.

Thank you very much