Hi all,

I'm trying to sort in ascending alphabet, names in an array.

Here is what I've done. It works well for the first letter, but not for
the following letters. So any help will be greatly appreciated!

'Function which transforms letters into figures:
Public Function Letter(Nom As Variant, Position As Integer) As Long


If UCase(Mid(CStr(Nom), Position, 1)) = "A" Then Letter = 1
If UCase(Mid(CStr(Nom), Position, 1)) = "B" Then Letter = 2
If UCase(Mid(CStr(Nom), Position, 1)) = "C" Then Letter = 3
If UCase(Mid(CStr(Nom), Position, 1)) = "D" Then Letter = 4
If UCase(Mid(CStr(Nom), Position, 1)) = "E" Then Letter = 5
If UCase(Mid(CStr(Nom), Position, 1)) = "F" Then Letter = 6
If UCase(Mid(CStr(Nom), Position, 1)) = "G" Then Letter = 7
If UCase(Mid(CStr(Nom), Position, 1)) = "H" Then Letter = 8
If UCase(Mid(CStr(Nom), Position, 1)) = "I" Then Letter = 9
If UCase(Mid(CStr(Nom), Position, 1)) = "J" Then Letter = 10
If UCase(Mid(CStr(Nom), Position, 1)) = "K" Then Letter = 11
If UCase(Mid(CStr(Nom), Position, 1)) = "L" Then Letter = 12
If UCase(Mid(CStr(Nom), Position, 1)) = "M" Then Letter = 13
If UCase(Mid(CStr(Nom), Position, 1)) = "N" Then Letter = 14
If UCase(Mid(CStr(Nom), Position, 1)) = "O" Then Letter = 15
If UCase(Mid(CStr(Nom), Position, 1)) = "P" Then Letter = 16
If UCase(Mid(CStr(Nom), Position, 1)) = "Q" Then Letter = 17
If UCase(Mid(CStr(Nom), Position, 1)) = "R" Then Letter = 18
If UCase(Mid(CStr(Nom), Position, 1)) = "S" Then Letter = 19
If UCase(Mid(CStr(Nom), Position, 1)) = "T" Then Letter = 20
If UCase(Mid(CStr(Nom), Position, 1)) = "U" Then Letter = 21
If UCase(Mid(CStr(Nom), Position, 1)) = "V" Then Letter = 22
If UCase(Mid(CStr(Nom), Position, 1)) = "W" Then Letter = 23
If UCase(Mid(CStr(Nom), Position, 1)) = "X" Then Letter = 24
If UCase(Mid(CStr(Nom), Position, 1)) = "Y" Then Letter = 25
If UCase(Mid(CStr(Nom), Position, 1)) = "Z" Then Letter = 26
End Function

'==========================================
'Here is the sorting procedure :
Private TempCode As Variant
Private TempNom As Variant
Private TempDate As Variant
Private TempOpen As Variant
Private TempHigh As Variant
Private TempLow As Variant
Private TempClose As Variant
Private TempVolume As Variant

Private LetterMin As Integer
Private CodeIndex As Long
Private LastSameCode As Long
Private StartCode As Long
Private FirstScan As Boolean

Private NewSymbol As Boolean

Private CodeLetterMin As Variant
Private NomLetterMin As Variant
Private DateLetterMin As Variant
Private OpenLetterMin As Variant
Private HighLetterMin As Variant
Private LowLetterMin As Variant
Private CloseLetterMin As Variant
Private VolumeLetterMin As Variant

Private Tn As Integer 'Compteur de la place de la lettre
Private ZArr As Long 'Compteur de ArrFusion
Private Zi As Integer 'Compteur d'index

Public SortingProc()
'It Sorts the array ArrFusionClean():

LastRowArrFusion = UBound(ArrFusionClean, 1)
StartCode = 1
LastSameCode = LastRowArrFusion
Tn = 1 'Position de la lettre dans le code
FirstScan = True
NewSymbol = True

FindLetter:


For ZArr = StartCode To LastSameCode
'Initialisation de StartCode pour le prochain code :

LetterMin = Letter(ArrFusionClean(ZArr, 1), Tn)
CodeIndex = ZArr 'Index
'Searching the 'smallest' letter :
For Zi = ZArr + 1 To LastSameCode 'For Zi = Zarr +1
If Letter(ArrFusionClean(Zi, 1), Tn) < LetterMin Then 'Tz
'Saving the 'smallest' letter : LetterMin =
Letter(ArrFusionClean(Zi, 1), Tn)
CodeIndex = Zi 'Index
CodeLetterMin = ArrFusionClean(Zi, 1)
NomLetterMin = ArrFusionClean(Zi, 2)
DateLetterMin = ArrFusionClean(Zi, 3)
OpenLetterMin = ArrFusionClean(Zi, 4)
HighLetterMin = ArrFusionClean(Zi, 5)
LowLetterMin = ArrFusionClean(Zi, 6)
CloseLetterMin = ArrFusionClean(Zi, 7)
VolumeLetterMin = ArrFusionClean(Zi, 8)
End If
Next Zi

'Swapinf Datas in an array :
If LetterMin < Letter(ArrFusionClean(ZArr, 1), Tn) Then
TempCode = ArrFusionClean(ZArr, 1)
ArrFusionClean(ZArr, 1) = CodeLetterMin
ArrFusionClean(CodeIndex, 1) = TempCode

TempNom = ArrFusionClean(ZArr, 2)
ArrFusionClean(ZArr, 2) = NomLetterMin
ArrFusionClean(CodeIndex, 2) = TempNom

TempDate = ArrFusionClean(ZArr, 3)
ArrFusionClean(ZArr, 3) = DateLetterMin
ArrFusionClean(CodeIndex, 3) = TempDate

TempOpen = ArrFusionClean(ZArr, 4)
ArrFusionClean(ZArr, 4) = OpenLetterMin
ArrFusionClean(CodeIndex, 4) = TempOpen

TempHigh = ArrFusionClean(ZArr, 5)
ArrFusionClean(ZArr, 5) = HighLetterMin
ArrFusionClean(CodeIndex, 5) = TempHigh

TempLow = ArrFusionClean(ZArr, 6)
ArrFusionClean(ZArr, 6) = LowLetterMin
ArrFusionClean(CodeIndex, 6) = TempLow

TempClose = ArrFusionClean(ZArr, 7)
ArrFusionClean(ZArr, 7) = CloseLetterMin
ArrFusionClean(CodeIndex, 7) = TempClose

TempVolume = ArrFusionClean(ZArr, 8)
ArrFusionClean(ZArr, 8) = VolumeLetterMin
ArrFusionClean(CodeIndex, 8) = TempVolume
End If
Next ZArr


If FirstScan = True Then
StartCode = 1
LastSameCode = 1
' FirstScan = False ' First Scan is done

Debug.Print "Tri par des codes par ordre alphabétique de la 1ère
lettre : "
For ZArr = 1 To LastRowArrFusion
Debug.Print ZArr & " , " & ArrFusionClean(ZArr, 1) & " , " &
ArrFusionClean(ZArr, 2) & " , " & ArrFusionClean(ZArr, 3) & " , " &
ArrFusionClean(ZArr, 4) & " , " & ArrFusionClean(ZArr, 5) & " , " &
ArrFusionClean(ZArr, 6) & " , " & ArrFusionClean(ZArr, 7) & " , " &
ArrFusionClean(ZArr, 8)
Next ZArr
Else
If NewSymbol = True Then
'Scanning a new name :
Tn = 1
StartCode = LastSameCode + 1
' NewSymbol = False
Else
If Tn < 4 Then 'Scanning all the letters in a name :
Tn = Tn + 1
End If
End If
End If



If StartCode < LastRowArrFusion And NewSymbol = True Then
For ZArr = StartCode To LastRowArrFusion
If Letter(ArrFusionClean(ZArr + 1, 1), Tn) =
Letter(ArrFusionClean(ZArr, 1), Tn) Then
LastSameCode = LastSameCode + 1

Else
Exit For
End If
Next ZArr
If FirstScan = True Then
FirstScan = False
NewSymbol = True
Else
NewSymbol = False
End If

If LastSameCode + StartCode - 1 <= LastRowArrFusion Then
LastSameCode = LastSameCode + StartCode - 1
Else
LastSameCode = LastRowArrFusion
End If

End If

'We Start again to FindLetter label :
If StartCode < LastRowArrFusion Then GoTo FindLetter

End Sub

'================================
'Many thanks for your help
'Phil






*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!