Aphabetize a listbox

[Anonymous]

I have a single dimension array of linetypes I want to load into a listbox.
The array is built as the linetype file is read, so they are in logical
order (to the designer), but not in alphabetical order. Is there an easy
way to reorder the elements of the array in aphabetical order before adding
them to the listbox, or maybe to just reorganize the listbox?

[Anonymous]

Ben

I have used this with an existing listbox1. I fill an array from listbox1.
Then I alphabetize the array and then re-fill listbox1. Since you have
the array of items, you could skip that step.

Hope this helps.

Chris


Dim Green As Integer 'outer loop
Dim Red As Integer 'inner loop
Dim intTemp As Integer
Dim strListArray(????) As String 'dimension as needed!!!!

For intTemp = 0 To ListBox1.ListCount - 1
strListArray(intTemp) = ListBox1.List(intTemp)
Next

For Green = ListBox1.ListCount - 1 To 0 Step -1
For Red = 0 To Green - 1
If UCase(strListArray(Red)) > UCase(strListArray(Red + 1)) Then
swap strListArray(Red), strListArray(Red + 1)
End If
Next Red
Next Green

Dim tempList As Integer
tempList = ListBox1.ListCount - 1
ListBox1.Clear

For intTemp = 0 To tempList
ListBox1.AddItem strListArray(intTemp)
Next intTemp

Public Sub swap(A As String, B As String)
Dim C As String

C = A
A = B
B = C

End Sub


"Ben Maki" wrote in message
news:3BCA3C39CD1A4B9C9AEE697799C3046D@in.WebX.maYIadrTaRb...
> I have a single dimension array of linetypes I want to load into a
listbox.
> The array is built as the linetype file is read, so they are in logical
> order (to the designer), but not in alphabetical order. Is there an easy
> way to reorder the elements of the array in aphabetical order before
adding
> them to the listbox, or maybe to just reorganize the listbox?
>
>

[Anonymous]

Hey Chris, nice piece of code! I took it and made it so any string array
passed to it will get alphabetized:

Public Sub Alphabetize(StringArray() As String)
Dim Green As Integer 'outer loop
Dim Red As Integer 'inner loop
Dim i As Integer
For Green = UBound(StringArray) To LBound(StringArray) Step -1
For Red = 0 To Green - 1
If UCase(StringArray(Red)) > UCase(StringArray(Red + 1)) Then
Swap StringArray(Red), StringArray(Red + 1)
End If
Next Red
Next Green
End Sub

Private Sub Swap(A As String, B As String)
Dim C As String: C = A: A = B: B = C
End Sub

[Anonymous]

I was having the problem with sorting items that had numeric components -
you know the issue where where 11 comes before 2 when you alpha sort
strings. For example

File 1
File 10
File 11
File 2
File 3
etc...

I was using the StrComp function in a procedure similar to yours. I replaced
StrComp with a function that breaks the two strings down into numeric and
non-numeric sections then does the appropriate comparisons. It has the same
return values as StrComp.

There is probably an easier way, but it works for any combination of numeric
and non-numeric characters.


Function AlphaNumStrComp(sComp As String, sBase As String) As Integer
' array of the sBase string seperated into non-numeric and numeric
characters
' Note: the array alternates non-numeric, numeric
Dim baseArray() As String
ReDim baseArray(1 To 1)
' array of the sBase string seperated into non-numeric and numeric
characters
Dim compArray() As String
ReDim compArray(1 To 1)

Dim numflag As Boolean
Dim arPos As Integer
Dim compCnt As Integer
Dim compStr As String
Dim compResult As Integer
Dim I As Integer

' separate the numeric values from the base string
numflag = False
arPos = 1
For I = 1 To Len(sBase)
compStr = Mid(sBase, I, 1)
If IsNumeric(compStr) Then
If numflag = False Then
arPos = arPos + 1
ReDim Preserve baseArray(1 To arPos)
baseArray(arPos) = compStr
numflag = True
Else
baseArray(arPos) = baseArray(arPos) & compStr
End If
Else
If numflag = True Then
arPos = arPos + 1
ReDim Preserve baseArray(1 To arPos)
baseArray(arPos) = compStr
numflag = False
Else
baseArray(arPos) = baseArray(arPos) & compStr
End If
End If
Next
compCnt = arPos

' separate the numeric values from the compare string
numflag = False
arPos = 1
For I = 1 To Len(sComp)
compStr = Mid(sComp, I, 1)
If IsNumeric(compStr) Then
If numflag = False Then
arPos = arPos + 1
ReDim Preserve compArray(1 To arPos)
compArray(arPos) = compStr
numflag = True
Else
compArray(arPos) = compArray(arPos) & compStr
End If
Else
If numflag = True Then
arPos = arPos + 1
ReDim Preserve compArray(1 To arPos)
compArray(arPos) = compStr
numflag = False
Else
compArray(arPos) = compArray(arPos) & compStr
End If
End If
Next
If arPos < compCnt Then
compCnt = arPos
End If

'compare results. If the values are equal, it will progress to the next
array pos
numflag = False
For I = 1 To compCnt
If numflag = False Then
' do an alpha compare
compResult = StrComp(compArray(I), baseArray(I), vbTextCompare)
If compResult = -1 Then
GoTo ValLessThan
ElseIf compResult = 1 Then
GoTo ValGreaterThan
End If
' values are the same, proceed to the next array position
numflag = True
Else
' do a numeric compare
If CDbl(compArray(I)) < CDbl(baseArray(I)) Then
GoTo ValLessThan
ElseIf CDbl(compArray(I)) > CDbl(baseArray(I)) Then
GoTo ValGreaterThan
End If
' values are the same, proceed to the next array position
numflag = False
End If
Next

' the values are identical
AlphaNumStrComp = 0
Exit Function

' the compare value is less then the base value
ValLessThan:
AlphaNumStrComp = -1

Exit Function

' the compare value is less then the base value
ValGreaterThan:
AlphaNumStrComp = 1

End Function