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. 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!

Hi,

I'am not sure what you actually mean by Alphabetize...?
So what would this
"The Law Firm of Cohen & Jaffe"
look like after conversion..?

Regards
Veena

Hi! Thanks for replying.

I mean sorting an array. For example, the array output would look like:

"Cohen Firm Jaffe Law of The"

Again, I can manually eliminate the garbage characters using find and replace.

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

I discovered the solution to this request, and I will post it so others can benefit, if they ever come across the same problem I had:

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

Another solution I found, which alphabetizes the whole sentence (not words)

Sub SortCell()
Dim Source As Range, Target As Range
Dim c As Range
Dim i As Long
Dim Temp()

Set Target = Selection.CurrentRegion.Offset(0, 1)
Set Target = Target.Resize(, 1)
Target.Clear
Set Source = Selection.CurrentRegion

For Each c In Source
ReDim Temp(0 To Len(c.Text) - 1)
For i = 0 To UBound(Temp)
Temp(i) = Mid(c.Text, i + 1, 1)
Next i
SingleBubbleSort Temp
c.Offset(0, 1).Value = Join(Temp, "")
Next c
End Sub

Function SingleBubbleSort(TempArray As Variant)
'copied directly from support.microsoft.com
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For i = 0 To UBound(TempArray) - 1

' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)

End Function

Thanks for all of those who have looked through my thread! My request has been resolved.

This article has been dead for over six months. Start a new discussion instead.