Sorting Names in an Array

  • Thread starter Thread starter Philippe Lhermie
  • Start date Start date
P

Philippe Lhermie

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
 
If all you want to do is sort, your code seems unnecessarily
complicated because all you need to do is write code to put the data
into a worksheet,sort it, then put it back into the array. Set your
macro recorder whilst doing the job manually.

Regards
BrianB
=============================================
 
Thanks Brian, for your help.

But your solution is by far the slowest. The reason I exported my Excel
spreadsheet into an array is for speed, especially when you have a lot
of verifications to do whith a lot of lines (20 000 lines). And I do not
want to use Access.

Anyway, thanks for replying.
Regards,
Phil
 
Folks,
I have to more clear:

I exported one spreadsheet into a 2 dimensions array for speed reason.
I would like to sort lines by code names, and not sort letters into
these names.

For example:

Jaguar,10
Ferrari,20
Mercedes,30
Februray, 40
Fest,50

The result should be:
Februray, 40
Ferrari,20
Fest,50
Jaguar,10
Mercedes,30


Regards,

Phil
 
SuperPhil said:
Folks,
I have to more clear:

I exported one spreadsheet into a 2 dimensions array for speed reason.
I would like to sort lines by code names, and not sort letters into
these names.

For example:

Jaguar,10
Ferrari,20
Mercedes,30
Februray, 40
Fest,50

The result should be:
Februray, 40
Ferrari,20
Fest,50
Jaguar,10
Mercedes,30
Click to expand...

Then I'd definitely suggest you use a disconnected ADO recordset
see

http://support.microsoft.com:80/support/kb/articles/Q257/8/19.ASP&NoWebContent=1

Keith
 
Many thanks Keith,

I'm trying to use ADO and SQL

I will let you know.
Thanks for your tip
Regards,

Phil
 
Hi all and Keith,

This message as also been posted partially on
microsoft.public.vb.database.ado)

My Excel Workbook will be used by users on Windows 98, 2000 and XP with
Excel 2000 or XP.

Because my spreadSheet may contain up to 20 000 rows, I decided to use
ADO for manipulating data.

1. Which library do I need to reference in the VBA Editor?

I have these ones on my PC :

Microsoft ActiveX Data Object 2.5 Library
Microsoft ActiveX Data Object 2.6 Library
Microsoft ActiveX Data Object 2.7 Library

In one of my books (VBA for Excel 2002, Stephen bullen, Wrox Campus
press),
they recommand the 2.5 library.

I Tried 2.5 and 2.7, and so far both work.

2. Which engine do you recommand?

Microsoft.Jet.OLEDB.4.0 or Microsoft Excel Driver (*.xls)}?


3. I noticed one SQL query doesn't work:
(I added a header to each column in row 1:
CODE,NAME,DATE, etc...)

SELECT *FROM [SHEET1$] works but
SELECT NAME FROM [SHEET1$] does not work although CODE exists.
Do you know why?



Any advice is greatly appreciated.
Regards,

Phil

Regards,

Phil
 
Back
Top