[RESOLVED] Alphabatize a string using VBA - For excel function

[choin2256]

Hi!

The program I am using is excel. What I am looking to do is alphabetize a string within a cell. Note, I do not wish to alphabetize a column of words.

Here is an example. Let's say cell A1 contains a string like so:

"The Law Firm of Cohen & Jaffe"

I would like to alphabetize this whole string, within the cell so that it should read:

"Cohen Firm Jaffe Law of The"

Any garbage characters I would not worry about, I can always get rid of them using find and replace. The important thing, is to alphabetize the string.

The purpose of this task, is because I need to match data from 2 different databases, but some fields on the other database, although similar, are off just by a little (such as, reverse ordering). That is why I cannot use a normal sort function in excel to match the two datasets. Thus, the reason why I need to alphabetize a string, within a cell.

Thanks for your help!

[westconn1]

you could split the cell content into an array using space character, sort the array, then join the array back into the cell
there are many examples for sorting an array in the vb6 forum or vb6 codebank

you could make this into a custom worksheet function

[choin2256]

I could do it that way, however I have about 8000 phrases (cells) to alphabetize, meaning, I would have to run the program 8000 times. So that method wouldn't be ideal. I need to sort each phrase within the cells using a VBA function as to save time. I just don't know how to create the function.

[choin2256]

I found this code, but it doesn't work in VBA. Maybe you can help me tweak it to perform the desired results?

    ' Takes any string, alphabetizes it, and returns the alphabetized string
    Private Function Alphabetize(ByVal originalString As String) As String
        Dim alphabetizedString As String = ""
        Dim tempString As String
        Dim Iterator As Integer
        Dim closestToA As Char
        Dim positionToRemove As Integer
        Dim charsToRemove As Integer
        Dim tempIterator As Integer

        tempString = originalString
        charsToRemove = tempString.Length

        ' Two For loops to work through the string; first one is to ensure
        ' removal of one character each pass; second one loops through
        ' all characters in the current temporary string
        For Iterator = 0 To charsToRemove - 1
            ' Set the character closest to a as equal to the first character
            ' of the temporary string
            closestToA = tempString.Chars(0)
            positionToRemove = 0

            For tempIterator = 1 To tempString.Length - 1
                If tempString.Chars(tempIterator) < closestToA Then
                    closestToA = tempString.Chars(tempIterator)
                    positionToRemove = tempIterator
                End If
            Next tempIterator

            ' Remove selected character from tempstring and append it to alphabetizedString
            tempString = tempString.Remove(positionToRemove, 1)
            alphabetizedString &= closestToA.ToString
        Next Iterator

        Return alphabetizedString

    End Function    ' Alphabetize

[westconn1]

try like this

Function alphasort(r As Range)
Dim c() As String
c = Split(r.Value)
qs c, LBound(c), UBound(c)
alphasort = Join(c)
End Function
Function qs(c() As String, ByVal First As Long, ByVal Last As Long)
    Dim Low As Long, High As Long
    Dim MidValue As String
    
    Low = First
    High = Last
    MidValue = c((First + Last) \ 2)
    
    Do
        Do While c(Low) < MidValue
            Low = Low + 1
        Loop
        Do While c(High) > MidValue
            High = High - 1
        Loop
                If Low <= High Then
''                    Swap C(High), C(Low)
                tempC = c(Low)
                c(Low) = c(High)
                c(High) = tempC
                    
                
            Low = Low + 1
            High = High - 1
        End If
    Loop While Low <= High
    
    If First < High Then qs c, First, High
    If Low < Last Then qs c, Low, Last
    qs = c
 
End Function

use alphasort as a worksheet function, or modify the arguments to use in a loop through a range
i tested this with your sample text, note it does not remove the "&" character, but returned
& Cohen Firm Jaffe Law The of
it would be pretty easy to remove any unwanted characters

[choin2256]

This does the trick! Thanks very much, you saved me about 8000 lines of data to analyze

[anhn]

Try this (for small arrays, we don't worry about method of sorting):

Option Explicit

Function Alphabetize(ByVal sText As String) As String
   Dim sWords() As String, sTemp As String
   Dim i As Long, j As Long, n As Long
   
   '-- clean up text
   For i = 1 To Len(sText)
      Select Case Mid$(sText, i, 1)
         Case " ", "a" To "z", "A" To "Z"
         Case Else: Mid$(sText, i, 1) = " "
      End Select
   Next
   '-- remove leading and trailing spaces
   sText = Trim(sText)
   '-- remove multi spaces
   Do While InStr(sText, "  ")
      sText = Replace(sText, "  ", " ")
   Loop
   '-- split text by space
   sWords = Split(sText)
   n = UBound(sWords)
   If n = 0 Then '-- only one word
      Alphabetize = sText
   Else
      '-- sort array
      For i = 0 To n - 1
         For j = i + 1 To n
            If sWords(i) > sWords(j) Then
               sTemp = sWords(i)
               sWords(i) = sWords(j)
               sWords(j) = sTemp
            End If
         Next
      Next
      Alphabetize = Join(sWords, " ")
   End If
End Function

Usage:
cell A2: The Law Firm of Cohen & Jaffe
cell B2: =Alphabetize(A2)