Multi tool use

Sorting a string

I'm trying to sort a string 'typestr' alphabetically:

typestr = "cda"
Dim temp As String
For i = 1 To Len(typeStr) - 1
For j = i + 1 To Len(typeStr)
If Mid(typeStr, i, 1) > Mid(typeStr, j, 1) Then
temp = Mid(typeStr, i, 1)
typeStr = Replace(typeStr, Mid(typeStr, i, 1), Mid(typeStr, j, 1), i, 1)
typeStr = Replace(typeStr, Mid(typeStr, j, 1), temp, j, 1)
End If
Next j
Next i


This all works fine until I come to the last Replace-function. Post first Replace-function the string is

typestr = ada


while my 'temp'-string is

temp = c


Since j = 3 at this point, the last replace should replace only the last a in ada, but what happens is that typestr gets replaced with temp

typestr = c


5 Answers
5

Here's an easier and much faster way using ArrayList:

ArrayList

Function SortString(inputStr As String) As String
Dim list As Object
Set list = CreateObject("System.Collections.ArrayList")

For i = 1 To Len(inputStr)
list.Add (Mid$(inputStr, i, 1))
Next
list.Sort

SortString = Join(list.ToArray, "")
End Function


Usage:

MsgBox SortString("cbazyx")


Output:

abcxyz

Try this:

Sub Alphabetically_SortArray()

my_string = InputBox("Provide a string. It will be sorted alphabetically")

Dim buff() As String
ReDim buff(Len(my_string) - 1)
For i = 1 To Len(my_string)
buff(i - 1) = Mid$(my_string, i, 1)
Next

Dim myArray As Variant
Dim x As Long, y As Long
Dim TempTxt1 As String
Dim TempTxt2 As String

myArray = buff

'Alphabetize Sheet Names in Array List
For x = LBound(myArray) To UBound(myArray)
For y = x To UBound(myArray)
If UCase(myArray(y)) < UCase(myArray(x)) Then
TempTxt1 = myArray(x)
TempTxt2 = myArray(y)
myArray(x) = TempTxt2
myArray(y) = TempTxt1
End If
Next y
Next x

i = 0
For Each Item In myArray
result = result & myArray(i)
i = i + 1
Next Item

MsgBox result

End Sub


The following code will accept strInput (any string) and return strOuput as that string sorted alphabetically ascending.

strOutput = Left(strInput, 1)

For intCnt = 2 To Len(strInput)
strChar = Mid(strInput, intCnt, 1)
For intChk = 1 To Len(strOutput)
If strChar < Mid(strOutput, intChk, 1) Then
strOutput = Left(strOutput, intChk - 1) + strChar + Mid(strOutput, intChk)
strChar = ""
Exit For
End If
Next intChk
strOutput = strOutput + strChar
Next intCnt


Solved it myself:

Function test_function(typestr As String)

For i = 1 To Len(typestr) - 1
For j = i + 1 To Len(typestr)
If Mid(typestr, i, 1) > Mid(typestr, j, 1) Then
temp = Mid(typestr, i, 1)
typestr = Replace(typestr, Mid(typestr, i, 1), Mid(typestr, j, 1), 1, 1)
typestr = Left(typestr, j - 1) & Replace(typestr, Mid(typestr, j, 1), temp, j, 1)
End If
Next j
Next i

test_function = typestr

End Function


The minimal change I know of is to use Mid() on the left-hand side of an assignment (which works!):

Mid()

Option Explicit

Public Function test_function(typeStr As String) As String
Dim i As Long, j As Long
Dim temp As String

For i = 1 To Len(typeStr) - 1
For j = i + 1 To Len(typeStr)
If Mid(typeStr, i, 1) > Mid(typeStr, j, 1) Then
temp = Mid(typeStr, i, 1)
Mid(typeStr, i, 1) = Mid(typeStr, j, 1) ' <====
Mid(typeStr, j, 1) = temp ' <====
End If
Next j
Next i
test_function = typeStr
End Function


With the swap fixed, test_function("aoiszb") returns abiosz.

test_function("aoiszb")

abiosz

The only substantive changes I made were to the two lines marked <====. Other than that, I added the code necessary to make an MCVE. I also added Option Explicit since it helps catch bugs and (in my personal opinion) should always be used.

<====

Option Explicit

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.