Can you sort one cell or a string in vba?

[John]

Say you have a string="14386ah"
Is there a excel vba function that will sort the string?

Thanks
JOhn

[Joel]

You need to perfrom a buble sort manually using code

Sub bubbleSort()

Mystring = "14386ah"

For i = 1 To (Len(Mystring) - 1)
For j = (i + 1) To Len(Mystring)

char_i = Mid(Mystring, i, 1)
char_j = Mid(Mystring, j, 1)

If Asc(char_i) > Asc(char_j) Then
'switch character
Mid(Mystring, i, 1) = char_j
Mid(Mystring, j, 1) = char_i
End If
Next j
Next i
End Sub

[RB Smissaert]

If you are dealing with large strings and speed is important then you could
use code like this.
Not tested, but I think it will be faster than a bubblesort.

Sub test()

Dim str As String

str = "azyxwvutsrqponmlkjihgfedcba"
MsgBox SortString(str)

End Sub

Function SortString(strString As String) As String

Dim btArray() As Byte
Dim btArray2() As Byte

btArray = strString

btArray2 = CountingSortByte1D(btArray)

SortString = ByteArrayToString(btArray2)

End Function

Function ByteArrayToString(btArray() As Byte) As String

Dim sAns As String
Dim lPos As Long

sAns = StrConv(btArray, vbUnicode)
lPos = InStr(sAns, Chr(0))

If lPos > 0 Then
sAns = Left(sAns, lPos - 1)
End If

ByteArrayToString = sAns

End Function

Function CountingSortByte1D(arrByte() As Byte) As Byte()

Dim i As Long
Dim LB As Long
Dim UB As Long
Dim arrCount() As Long
Dim arrByteSorted() As Byte
Dim lThisCount As Long
Dim lNext_Offset As Long

LB = LBound(arrByte)
UB = UBound(arrByte)

'Create the Counts array
ReDim arrCount(0 To 255)

'create the sorted return array
ReDim arrByteSorted(LB To UB \ 2) As Byte

'Count the items
For i = LB To UB Step 2
arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1
Next i

'Convert the arrCount into offsets
lNext_Offset = LB

For i = 0 To 255
lThisCount = arrCount(i)
arrCount(i) = lNext_Offset
lNext_Offset = lNext_Offset + lThisCount
Next i

'Place the items in the sorted array
For i = LB To UB Step 2
arrByteSorted(arrCount(arrByte(i))) = arrByte(i)
arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1
Next i

CountingSortByte1D = arrByteSorted

End Function

RBS

"John" <john...@comcast.com> wrote in message
news:%23Py7Di8...@TK2MSFTNGP03.phx.gbl...

[Rick Rothstein]

Here is my attempt at a solution. Place the following in a general Module
(Insert/Module from the VB editor's menu bar)...

Function SortCharacters(S As String) As String
Dim X As Long, Z As Long, Cnt As Long
ReDim C(1 To Len(S)) As Long
For X = 1 To Len(S)
For Z = 1 To Len(S)
If Mid(S, Z, 1) < Mid(S, X, 1) Then C(X) = C(X) + 1
Next
Next
SortCharacters = Space(Len(S))
For X = 1 To Len(S)
Mid(SortCharacters, C(X) + 1, 1) = Mid(S, X, 1)
Next
End Function

Just call this function from your own code passing the text you want to
sort. As an example...

MyString = "14386ah"
MsgBox SortCharacters(MyString)

This function can also be used as a UDF (user defined function) on the
worksheet as well. As an example...

=SortCharacters(A1)

--
Rick (MVP - Excel)

"John" <john...@comcast.com> wrote in message
news:%23Py7Di8...@TK2MSFTNGP03.phx.gbl...

[John]

Thanks. Been using something like this. I thought vba would have
something more elegant.
John

[John]

Thanks... I've been using somthing like that. i just thought vba would
have something more elegant
JOhn

[Peter T]

One more, normally will want to sort "BAab" to "AaBb"

Function SortString(ByVal strIn) As String
Dim i As Long, j As Long
Dim s1 As String, s2 As String

For i = 1 To (Len(strIn) - 1)
For j = (i + 1) To Len(strIn)

s1 = Mid$(strIn, i, 1)
s2 = Mid$(strIn, j, 1)

If StrComp(s1, s2, vbTextCompare) = 1 Then
Mid$(strIn, i, 1) = s2
Mid$(strIn, j, 1) = s1

End If
Next j
Next i

SortString = strIn

End Function

Regards,
Peter T

"John" <john...@comcast.com> wrote in message
news:%23Py7Di8...@TK2MSFTNGP03.phx.gbl...

[RB Smissaert]

Try this string:
"ZZYYyy22222211111"

Not that may suggestion is perfect, but very fast though :-)

RBS

"Rick Rothstein" <rick.new...@NO.SPAMverizon.net> wrote in message
news:OZGzhrEH...@TK2MSFTNGP05.phx.gbl...

[Rick Rothstein]

Picky... picky... picky <g>

Okay, this modification should work correctly...

Function SortCharacters(ByVal S As String) As String

Dim X As Long, Z As Long, Cnt As Long
ReDim C(1 To Len(S)) As Long
For X = 1 To Len(S)
For Z = 1 To Len(S)

If Mid(S, Z, 1) <= Mid(S, X, 1) Then C(X) = C(X) + 1
Next
Next
SortCharacters = String(Len(S), Chr$(1))

For X = 1 To Len(S)

Mid(SortCharacters, C(X), 1) = Mid(S, X, 1)
Next
For X = Len(S) - 1 To 1 Step -1
If Mid(SortCharacters, X, 1) = Chr$(1) Then
Mid(SortCharacters, X, 1) = Mid(SortCharacters, X + 1, 1)
End If
Next
End Function

I'm not sure how it would compare speedwise with your (or any other)
routine, but I don't think it will be a slouch by any means (that's a gut
feeling based on past experience with the "string stuffing" method I have
employed). Anyway, the assumed size of the text string the function would be
used with probably makes differences in efficiency moot.

--
Rick (MVP - Excel)

"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:ekqtrlGH...@TK2MSFTNGP03.phx.gbl...

[RB Smissaert]

The code I posted had a flaw in that it didn't sort AaBbCc etc.
With a simple byte converter this is now fixed and this carries only a very
small performance penalty and
it is still a lot faster than the posted bubblesorts. The strings this works
on may be small, but if you use it
as a worksheet UDF and it works on a lot of cells then speed could be
important. I added a timing test, so
you can see the difference.

Option Explicit
Private lStartTime As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private arrLookup(0 To 255) As Byte
Private arrLookup2(0 To 255) As Byte
Private bFilledLookupArray1 As Boolean
Private bFilledLookupArray2 As Boolean

Sub test()

Dim i As Long
Dim str As String
Dim strSorted As String
Dim bSortAaBb As Boolean
Dim bCountingSort As Boolean
Dim bUseSortCharacters As Boolean

str = "ZYXWVUTSRQPONMLKJIHGFEDCBA zyxwvutsrqponmlkjihgfedcba
9876543210"

If MsgBox("Use the CountingSort?", vbYesNo, "sorting string") = vbYes Then
bCountingSort = True
If MsgBox("Sort as AaBbCc etc.?", vbYesNo, "sorting string") = vbYes
Then
bSortAaBb = True
End If
Else
If MsgBox("Use SortCharacters?", vbYesNo, "sorting string") = vbYes Then
bUseSortCharacters = True
End If
End If

StartSW

If bCountingSort Then
For i = 0 To 1000
strSorted = SortString(str, bSortAaBb)
Next i
Else
If bUseSortCharacters Then
For i = 0 To 1000
strSorted = SortCharacters(str)
Next i
Else
For i = 0 To 1000
strSorted = SortString2(str)
Next i
End If
End If

StopSW

MsgBox strSorted, , "sorted string"

End Sub

Function SortString(strString As String, Optional bSortAaBb As Boolean) As
String

Dim i As Long

Dim btArray() As Byte
Dim btArray2() As Byte

btArray = strString

If bSortAaBb Then
If bFilledLookupArray1 = False Then
FillLookupArray1
End If
For i = 0 To UBound(btArray) Step 2
btArray(i) = arrLookup(btArray(i))
Next i
End If

btArray2 = CountingSortByte1D(btArray)

If bSortAaBb Then
If bFilledLookupArray2 = False Then
FillLookupArray2
End If
For i = 0 To UBound(btArray2)
btArray2(i) = arrLookup2(btArray2(i))
Next i
End If

SortString = ByteArrayToString(btArray2)

End Function

Function SortString2(ByVal strIn) As String

Dim i As Long
Dim j As Long
Dim s1 As String
Dim s2 As String

For i = 1 To (Len(strIn) - 1)
For j = (i + 1) To Len(strIn)

s1 = Mid$(strIn, i, 1)
s2 = Mid$(strIn, j, 1)

If StrComp(s1, s2, vbTextCompare) = 1 Then
Mid$(strIn, i, 1) = s2
Mid$(strIn, j, 1) = s1
End If
Next j
Next i

SortString2 = strIn

End Function

Function SortCharacters(ByVal S As String) As String

Dim X As Long
Dim Z As Long
Dim Cnt As Long

ReDim C(1 To Len(S)) As Long

For X = 1 To Len(S)
For Z = 1 To Len(S)
If Mid(S, Z, 1) <= Mid(S, X, 1) Then C(X) = C(X) + 1
Next
Next

SortCharacters = String(Len(S), Chr$(1))

For X = 1 To Len(S)
Mid(SortCharacters, C(X), 1) = Mid(S, X, 1)
Next
For X = Len(S) - 1 To 1 Step -1
If Mid(SortCharacters, X, 1) = Chr$(1) Then
Mid(SortCharacters, X, 1) = Mid(SortCharacters, X + 1, 1)
End If
Next

End Function

Sub FillLookupArray1()

arrLookup(0) = 255
arrLookup(1) = 11
arrLookup(2) = 12
arrLookup(3) = 13
arrLookup(4) = 14
arrLookup(5) = 15
arrLookup(6) = 16
arrLookup(7) = 17
arrLookup(8) = 18
arrLookup(9) = 49
arrLookup(10) = 50
arrLookup(11) = 51
arrLookup(12) = 52
arrLookup(13) = 53
arrLookup(14) = 19
arrLookup(15) = 20
arrLookup(16) = 21
arrLookup(17) = 22
arrLookup(18) = 23
arrLookup(19) = 24
arrLookup(20) = 25
arrLookup(21) = 26
arrLookup(22) = 27
arrLookup(23) = 28
arrLookup(24) = 29
arrLookup(25) = 30
arrLookup(26) = 31
arrLookup(27) = 32
arrLookup(28) = 33
arrLookup(29) = 34
arrLookup(30) = 35
arrLookup(31) = 36
arrLookup(32) = 47
arrLookup(33) = 54
arrLookup(34) = 55
arrLookup(35) = 56
arrLookup(36) = 57
arrLookup(37) = 58
arrLookup(38) = 59
arrLookup(39) = 10
arrLookup(40) = 60
arrLookup(41) = 61
arrLookup(42) = 62
arrLookup(43) = 97
arrLookup(44) = 63
arrLookup(45) = 43
arrLookup(46) = 64
arrLookup(47) = 65
arrLookup(48) = 0
arrLookup(49) = 1
arrLookup(50) = 2
arrLookup(51) = 3
arrLookup(52) = 4
arrLookup(53) = 5
arrLookup(54) = 6
arrLookup(55) = 7
arrLookup(56) = 8
arrLookup(57) = 9
arrLookup(58) = 66
arrLookup(59) = 67
arrLookup(60) = 98
arrLookup(61) = 99
arrLookup(62) = 100
arrLookup(63) = 68
arrLookup(64) = 69
arrLookup(65) = 130
arrLookup(66) = 147
arrLookup(67) = 149
arrLookup(68) = 153
arrLookup(69) = 157
arrLookup(70) = 167
arrLookup(71) = 170
arrLookup(72) = 172
arrLookup(73) = 174
arrLookup(74) = 184
arrLookup(75) = 186
arrLookup(76) = 188
arrLookup(77) = 190
arrLookup(78) = 192
arrLookup(79) = 196
arrLookup(80) = 213
arrLookup(81) = 215
arrLookup(82) = 217
arrLookup(83) = 219
arrLookup(84) = 224
arrLookup(85) = 229
arrLookup(86) = 239
arrLookup(87) = 241
arrLookup(88) = 243
arrLookup(89) = 245
arrLookup(90) = 251
arrLookup(91) = 70
arrLookup(92) = 71
arrLookup(93) = 72
arrLookup(94) = 73
arrLookup(95) = 75
arrLookup(96) = 76
arrLookup(97) = 131
arrLookup(98) = 148
arrLookup(99) = 150
arrLookup(100) = 154
arrLookup(101) = 158
arrLookup(102) = 168
arrLookup(103) = 171
arrLookup(104) = 173
arrLookup(105) = 175
arrLookup(106) = 185
arrLookup(107) = 187
arrLookup(108) = 189
arrLookup(109) = 191
arrLookup(110) = 193
arrLookup(111) = 197
arrLookup(112) = 214
arrLookup(113) = 216
arrLookup(114) = 218
arrLookup(115) = 220
arrLookup(116) = 225
arrLookup(117) = 230
arrLookup(118) = 240
arrLookup(119) = 242
arrLookup(120) = 244
arrLookup(121) = 246
arrLookup(122) = 252
arrLookup(123) = 77
arrLookup(124) = 78
arrLookup(125) = 79
arrLookup(126) = 80
arrLookup(127) = 37
arrLookup(128) = 123
arrLookup(129) = 38
arrLookup(130) = 91
arrLookup(131) = 169
arrLookup(132) = 94
arrLookup(133) = 121
arrLookup(134) = 118
arrLookup(135) = 119
arrLookup(136) = 74
arrLookup(137) = 122
arrLookup(138) = 221
arrLookup(139) = 95
arrLookup(140) = 211
arrLookup(141) = 39
arrLookup(142) = 253
arrLookup(143) = 40
arrLookup(144) = 41
arrLookup(145) = 89
arrLookup(146) = 90
arrLookup(147) = 92
arrLookup(148) = 93
arrLookup(149) = 120
arrLookup(150) = 45
arrLookup(151) = 46
arrLookup(152) = 88
arrLookup(153) = 228
arrLookup(154) = 222
arrLookup(155) = 96
arrLookup(156) = 212
arrLookup(157) = 42
arrLookup(158) = 254
arrLookup(159) = 249
arrLookup(160) = 48
arrLookup(161) = 81
arrLookup(162) = 106
arrLookup(163) = 107
arrLookup(164) = 108
arrLookup(165) = 109
arrLookup(166) = 82
arrLookup(167) = 110
arrLookup(168) = 83
arrLookup(169) = 111
arrLookup(170) = 132
arrLookup(171) = 102
arrLookup(172) = 112
arrLookup(173) = 44
arrLookup(174) = 113
arrLookup(175) = 84
arrLookup(176) = 114
arrLookup(177) = 101
arrLookup(178) = 128
arrLookup(179) = 129
arrLookup(180) = 85
arrLookup(181) = 115
arrLookup(182) = 116
arrLookup(183) = 117
arrLookup(184) = 86
arrLookup(185) = 127
arrLookup(186) = 198
arrLookup(187) = 103
arrLookup(188) = 124
arrLookup(189) = 125
arrLookup(190) = 126
arrLookup(191) = 87
arrLookup(192) = 135
arrLookup(193) = 133
arrLookup(194) = 137
arrLookup(195) = 141
arrLookup(196) = 139
arrLookup(197) = 143
arrLookup(198) = 145
arrLookup(199) = 151
arrLookup(200) = 161
arrLookup(201) = 159
arrLookup(202) = 163
arrLookup(203) = 165
arrLookup(204) = 178
arrLookup(205) = 176
arrLookup(206) = 180
arrLookup(207) = 182
arrLookup(208) = 155
arrLookup(209) = 194
arrLookup(210) = 201
arrLookup(211) = 199
arrLookup(212) = 203
arrLookup(213) = 207
arrLookup(214) = 205
arrLookup(215) = 104
arrLookup(216) = 209
arrLookup(217) = 233
arrLookup(218) = 231
arrLookup(219) = 235
arrLookup(220) = 237
arrLookup(221) = 247
arrLookup(222) = 226
arrLookup(223) = 223
arrLookup(224) = 136
arrLookup(225) = 134
arrLookup(226) = 138
arrLookup(227) = 142
arrLookup(228) = 140
arrLookup(229) = 144
arrLookup(230) = 146
arrLookup(231) = 152
arrLookup(232) = 162
arrLookup(233) = 160
arrLookup(234) = 164
arrLookup(235) = 166
arrLookup(236) = 179
arrLookup(237) = 177
arrLookup(238) = 181
arrLookup(239) = 183
arrLookup(240) = 156
arrLookup(241) = 195
arrLookup(242) = 202
arrLookup(243) = 200
arrLookup(244) = 204
arrLookup(245) = 208
arrLookup(246) = 206
arrLookup(247) = 105
arrLookup(248) = 210
arrLookup(249) = 234
arrLookup(250) = 232
arrLookup(251) = 236
arrLookup(252) = 238
arrLookup(253) = 248
arrLookup(254) = 227
arrLookup(255) = 250

bFilledLookupArray1 = True

End Sub

Sub FillLookupArray2()

arrLookup2(0) = 48
arrLookup2(1) = 49
arrLookup2(2) = 50
arrLookup2(3) = 51
arrLookup2(4) = 52
arrLookup2(5) = 53
arrLookup2(6) = 54
arrLookup2(7) = 55
arrLookup2(8) = 56
arrLookup2(9) = 57
arrLookup2(10) = 39
arrLookup2(11) = 1
arrLookup2(12) = 2
arrLookup2(13) = 3
arrLookup2(14) = 4
arrLookup2(15) = 5
arrLookup2(16) = 6
arrLookup2(17) = 7
arrLookup2(18) = 8
arrLookup2(19) = 14
arrLookup2(20) = 15
arrLookup2(21) = 16
arrLookup2(22) = 17
arrLookup2(23) = 18
arrLookup2(24) = 19
arrLookup2(25) = 20
arrLookup2(26) = 21
arrLookup2(27) = 22
arrLookup2(28) = 23
arrLookup2(29) = 24
arrLookup2(30) = 25
arrLookup2(31) = 26
arrLookup2(32) = 27
arrLookup2(33) = 28
arrLookup2(34) = 29
arrLookup2(35) = 30
arrLookup2(36) = 31
arrLookup2(37) = 127
arrLookup2(38) = 129
arrLookup2(39) = 141
arrLookup2(40) = 143
arrLookup2(41) = 144
arrLookup2(42) = 157
arrLookup2(43) = 45
arrLookup2(44) = 173
arrLookup2(45) = 150
arrLookup2(46) = 151
arrLookup2(47) = 32
arrLookup2(48) = 160
arrLookup2(49) = 9
arrLookup2(50) = 10
arrLookup2(51) = 11
arrLookup2(52) = 12
arrLookup2(53) = 13
arrLookup2(54) = 33
arrLookup2(55) = 34
arrLookup2(56) = 35
arrLookup2(57) = 36
arrLookup2(58) = 37
arrLookup2(59) = 38
arrLookup2(60) = 40
arrLookup2(61) = 41
arrLookup2(62) = 42
arrLookup2(63) = 44
arrLookup2(64) = 46
arrLookup2(65) = 47
arrLookup2(66) = 58
arrLookup2(67) = 59
arrLookup2(68) = 63
arrLookup2(69) = 64
arrLookup2(70) = 91
arrLookup2(71) = 92
arrLookup2(72) = 93
arrLookup2(73) = 94
arrLookup2(74) = 136
arrLookup2(75) = 95
arrLookup2(76) = 96
arrLookup2(77) = 123
arrLookup2(78) = 124
arrLookup2(79) = 125
arrLookup2(80) = 126
arrLookup2(81) = 161
arrLookup2(82) = 166
arrLookup2(83) = 168
arrLookup2(84) = 175
arrLookup2(85) = 180
arrLookup2(86) = 184
arrLookup2(87) = 191
arrLookup2(88) = 152
arrLookup2(89) = 145
arrLookup2(90) = 146
arrLookup2(91) = 130
arrLookup2(92) = 147
arrLookup2(93) = 148
arrLookup2(94) = 132
arrLookup2(95) = 139
arrLookup2(96) = 155
arrLookup2(97) = 43
arrLookup2(98) = 60
arrLookup2(99) = 61
arrLookup2(100) = 62
arrLookup2(101) = 177
arrLookup2(102) = 171
arrLookup2(103) = 187
arrLookup2(104) = 215
arrLookup2(105) = 247
arrLookup2(106) = 162
arrLookup2(107) = 163
arrLookup2(108) = 164
arrLookup2(109) = 165
arrLookup2(110) = 167
arrLookup2(111) = 169
arrLookup2(112) = 172
arrLookup2(113) = 174
arrLookup2(114) = 176
arrLookup2(115) = 181
arrLookup2(116) = 182
arrLookup2(117) = 183
arrLookup2(118) = 134
arrLookup2(119) = 135
arrLookup2(120) = 149
arrLookup2(121) = 133
arrLookup2(122) = 137
arrLookup2(123) = 128
arrLookup2(124) = 188
arrLookup2(125) = 189
arrLookup2(126) = 190
arrLookup2(127) = 185
arrLookup2(128) = 178
arrLookup2(129) = 179
arrLookup2(130) = 65
arrLookup2(131) = 97
arrLookup2(132) = 170
arrLookup2(133) = 193
arrLookup2(134) = 225
arrLookup2(135) = 192
arrLookup2(136) = 224
arrLookup2(137) = 194
arrLookup2(138) = 226
arrLookup2(139) = 196
arrLookup2(140) = 228
arrLookup2(141) = 195
arrLookup2(142) = 227
arrLookup2(143) = 197
arrLookup2(144) = 229
arrLookup2(145) = 198
arrLookup2(146) = 230
arrLookup2(147) = 66
arrLookup2(148) = 98
arrLookup2(149) = 67
arrLookup2(150) = 99
arrLookup2(151) = 199
arrLookup2(152) = 231
arrLookup2(153) = 68
arrLookup2(154) = 100
arrLookup2(155) = 208
arrLookup2(156) = 240
arrLookup2(157) = 69
arrLookup2(158) = 101
arrLookup2(159) = 201
arrLookup2(160) = 233
arrLookup2(161) = 200
arrLookup2(162) = 232
arrLookup2(163) = 202
arrLookup2(164) = 234
arrLookup2(165) = 203
arrLookup2(166) = 235
arrLookup2(167) = 70
arrLookup2(168) = 102
arrLookup2(169) = 131
arrLookup2(170) = 71
arrLookup2(171) = 103
arrLookup2(172) = 72
arrLookup2(173) = 104
arrLookup2(174) = 73
arrLookup2(175) = 105
arrLookup2(176) = 205
arrLookup2(177) = 237
arrLookup2(178) = 204
arrLookup2(179) = 236
arrLookup2(180) = 206
arrLookup2(181) = 238
arrLookup2(182) = 207
arrLookup2(183) = 239
arrLookup2(184) = 74
arrLookup2(185) = 106
arrLookup2(186) = 75
arrLookup2(187) = 107
arrLookup2(188) = 76
arrLookup2(189) = 108
arrLookup2(190) = 77
arrLookup2(191) = 109
arrLookup2(192) = 78
arrLookup2(193) = 110
arrLookup2(194) = 209
arrLookup2(195) = 241
arrLookup2(196) = 79
arrLookup2(197) = 111
arrLookup2(198) = 186
arrLookup2(199) = 211
arrLookup2(200) = 243
arrLookup2(201) = 210
arrLookup2(202) = 242
arrLookup2(203) = 212
arrLookup2(204) = 244
arrLookup2(205) = 214
arrLookup2(206) = 246
arrLookup2(207) = 213
arrLookup2(208) = 245
arrLookup2(209) = 216
arrLookup2(210) = 248
arrLookup2(211) = 140
arrLookup2(212) = 156
arrLookup2(213) = 80
arrLookup2(214) = 112
arrLookup2(215) = 81
arrLookup2(216) = 113
arrLookup2(217) = 82
arrLookup2(218) = 114
arrLookup2(219) = 83
arrLookup2(220) = 115
arrLookup2(221) = 138
arrLookup2(222) = 154
arrLookup2(223) = 223
arrLookup2(224) = 84
arrLookup2(225) = 116
arrLookup2(226) = 222
arrLookup2(227) = 254
arrLookup2(228) = 153
arrLookup2(229) = 85
arrLookup2(230) = 117
arrLookup2(231) = 218
arrLookup2(232) = 250
arrLookup2(233) = 217
arrLookup2(234) = 249
arrLookup2(235) = 219
arrLookup2(236) = 251
arrLookup2(237) = 220
arrLookup2(238) = 252
arrLookup2(239) = 86
arrLookup2(240) = 118
arrLookup2(241) = 87
arrLookup2(242) = 119
arrLookup2(243) = 88
arrLookup2(244) = 120
arrLookup2(245) = 89
arrLookup2(246) = 121
arrLookup2(247) = 221
arrLookup2(248) = 253
arrLookup2(249) = 159
arrLookup2(250) = 255
arrLookup2(251) = 90
arrLookup2(252) = 122
arrLookup2(253) = 142
arrLookup2(254) = 158
arrLookup2(255) = 0

bFilledLookupArray2 = True

End Sub

ByteArrayToString = sAns

End Function

CountingSortByte1D = arrByteSorted

End Function

Sub StartSW()
lStartTime = timeGetTime()
End Sub

Function StopSW(Optional bMsgBox As Boolean = True, _
Optional vMessage As Variant, _
Optional lMinimumTimeToShow As Long = -1) As Variant

Dim lTime As Long

lTime = timeGetTime() - lStartTime

If lTime > lMinimumTimeToShow Then
If IsMissing(vMessage) Then
StopSW = lTime
Else
StopSW = lTime & " - " & vMessage
End If
End If

If bMsgBox Then
If lTime > lMinimumTimeToShow Then
MsgBox "Done in " & lTime & " msecs", , vMessage
End If
End If

End Function

RBS

"John" <john...@comcast.com> wrote in message
news:%23Py7Di8...@TK2MSFTNGP03.phx.gbl...

[RB Smissaert]

Can speed it up a bit and simplify it a bit by avoiding the second
conversion array and
handle the conversion back to the original characters in the counting sort:

Option Explicit
Private lStartTime As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private arrLookup(0 To 255) As Byte

Private bFilledLookupArray1 As Boolean

Sub test()

Dim i As Long
Dim str As String
Dim strSorted As String
Dim bSortAaBb As Boolean
Dim bCountingSort As Boolean
Dim bUseSortCharacters As Boolean

str = "ZYXWVUTSRQPONMLKJIHGFEDCBA zyxwvutsrqponmlkjihgfedcba 9876543210

?/><||||||����,."

StartSW

StopSW

End Sub

btArray = strString

btArray2 = CountingSortByte1D(btArray, bSortAaBb)

SortString = ByteArrayToString(btArray2)

End Function

Function CountingSortByte1D(arrByte() As Byte, bSortAaBb As Boolean) As
Byte()

Dim i As Long
Dim LB As Long
Dim UB As Long
Dim arrCount() As Long

Dim arrByte2() As Byte

Dim arrByteSorted() As Byte
Dim lThisCount As Long
Dim lNext_Offset As Long

LB = LBound(arrByte)
UB = UBound(arrByte)

If bSortAaBb Then

If bFilledLookupArray1 = False Then
FillLookupArray1
End If

ReDim arrByte2(0 To UB) As Byte
For i = 0 To UB Step 2
arrByte2(i) = arrLookup(arrByte(i))
Next i
End If

'Create the Counts array
ReDim arrCount(0 To 255)

'create the sorted return array
ReDim arrByteSorted(LB To UB \ 2) As Byte

'Count the items
If bSortAaBb Then

For i = LB To UB Step 2

arrCount(arrByte2(i)) = arrCount(arrByte2(i)) + 1
Next i
Else

For i = LB To UB Step 2
arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1
Next i

End If

'Convert the arrCount into offsets
lNext_Offset = LB

For i = 0 To 255
lThisCount = arrCount(i)
arrCount(i) = lNext_Offset
lNext_Offset = lNext_Offset + lThisCount
Next i

'Place the items in the sorted array

If bSortAaBb Then

For i = LB To UB Step 2

arrByteSorted(arrCount(arrByte2(i))) = arrByte(i)
arrCount(arrByte2(i)) = arrCount(arrByte2(i)) + 1
Next i
Else

For i = LB To UB Step 2
arrByteSorted(arrCount(arrByte(i))) = arrByte(i)
arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1
Next i

End If

CountingSortByte1D = arrByteSorted

End Function

Function SortString2(ByVal strIn) As String

SortString2 = strIn

End Function

SortCharacters = String(Len(S), Chr$(1))

End Function

Sub FillLookupArray1()

bFilledLookupArray1 = True

End Sub

Function ByteArrayToString(btArray() As Byte) As String

Dim sAns As String
Dim lPos As Long

sAns = StrConv(btArray, vbUnicode)
lPos = InStr(sAns, Chr(0))

If lPos > 0 Then
sAns = Left(sAns, lPos - 1)
End If

ByteArrayToString = sAns

End Function

Sub StartSW()

lStartTime = timeGetTime()
End Sub

Function StopSW(Optional bMsgBox As Boolean = True, _
Optional vMessage As Variant, _
Optional lMinimumTimeToShow As Long = -1) As Variant

Dim lTime As Long

lTime = timeGetTime() - lStartTime

If lTime > lMinimumTimeToShow Then
If IsMissing(vMessage) Then
StopSW = lTime
Else
StopSW = lTime & " - " & vMessage
End If
End If

If bMsgBox Then
If lTime > lMinimumTimeToShow Then
MsgBox "Done in " & lTime & " msecs", , vMessage
End If
End If

End Function

RBS

"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message

news:uZGCFySH...@TK2MSFTNGP03.phx.gbl...