Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

alphabetizing a list of names by last name

Posted on 1999-07-13
31
Medium Priority
?
716 Views
Last Modified: 2008-02-01
I would like to take a list of names and alphabetize them by last name, some people have a middle name included so I have to look out for that. I have about 7000 names to alphabetize. How would I go about doing that in VB 4 16 bit.
Code please...
0
Comment
Question by:dtucker
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 16
  • 9
  • 3
  • +2
31 Comments
 
LVL 1

Expert Comment

by:eab111098
ID: 1524313
well, you need to provide us a little more information. Where are these 7000 names stored? Database? Flat file? The answer to these questions will determine the answer to your own.

If its a database, are the first, middle, and last names in their own respective fields or in one field? If its a flat file, are these entries tab delimited or just strung together in one big long string?

Gotta know the data structure to answer your question.


Ed.
0
 

Author Comment

by:dtucker
ID: 1524314
They are in a random data file with the each name being in 1string (No first/middle/last) so I would have to loop thru the entire database file and read each name and then do what I need to do.
0
 
LVL 15

Expert Comment

by:ameba
ID: 1524315
Is this correct?
1 Anna Maria/Middle/Surname
2 John//Tucker

Are you using VB6?
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Expert Comment

by:eab111098
ID: 1524316
assuming you know how to read the file then its a simple of matter of arranging them in an array structure as you read them.

as you read each last name from the file, compare it against those you've already read and insert it into the array in its alphabetized slot.

or, even easier than that. read this random file into an ordinary text file. now, import it into ms access. in the import, set the "column" where each field begins/ends. now, once the data is there you can sort it on any field you desire.

comparing the two methods of reaching your goal, i'd say the latter is the way to go. dump it into access and then do what you want with it. you'll be done with it in an hour as opposed to 3 or four the former way.

ed.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524317
Ok, here you go...

On a form, stick a text box, a command button and a list box.

Then paste the code from the following code module.

As you can see, you can enter the names in the text box, and every time you hit enter it puts it in the correct place in the list.

It is very easy to modify this code to do exactly what you want.

Good luck!

Pino
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524318
Ok, here you go...

On a form, stick a text box, a command button and a list box.

Then paste the code from the following code module.

As you can see, you can enter the names in the text box, and every time you hit enter it puts it in the correct place in the list.

It is very easy to modify this code to do exactly what you want.

Good luck!

Pino
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524319
Option Explicit
Dim objCollection As Collection

Private Sub Command1_Click()

Dim lngIndex As Long
Dim blnMatch As Boolean

BinarySearch Text1.Text, lngIndex, blnMatch

If lngIndex = 0 Then
    If objCollection.Count = 0 Then
        objCollection.Add Text1.Text
    Else
        objCollection.Add Text1.Text, , 1
    End If
Else
    objCollection.Add Text1.Text, , , lngIndex
End If

List1.Clear
For lngIndex = 1 To objCollection.Count
    List1.AddItem objCollection(lngIndex)
Next

Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)

End Sub

Private Sub BinarySearch(ByVal strString As String, lngIndex As Long, blnMatch As Boolean)

If objCollection Is Nothing Then
    Set objCollection = New Collection
    lngIndex = 0
    blnMatch = False
    Exit Sub
End If

If GetLastName(objCollection(1)) > GetLastName(strString) Then
    lngIndex = 0
    blnMatch = False
    Exit Sub
End If

If GetLastName(objCollection(objCollection.Count)) <= GetLastName(strString) Then
    lngIndex = objCollection.Count
    blnMatch = False
    Exit Sub
End If

Dim lngStart As Long
Dim lngEnd As Long
Dim lngCurrent As Long

lngStart = 1
lngEnd = objCollection.Count
lngCurrent = (lngEnd + lngStart) \ 2
Do While lngStart < lngEnd - 1
    If GetLastName(objCollection(lngCurrent)) <= GetLastName(strString) Then
        lngStart = lngCurrent
    Else
        lngEnd = lngCurrent
    End If
    lngCurrent = (lngEnd + lngStart) \ 2
Loop

lngIndex = lngCurrent

End Sub

Private Function GetLastName(ByVal strString As String) As String

Dim intPos As Integer
Dim intLastPos As Integer

intPos = InStr(strString, " ")

If intPos = 0 Then
    GetLastName = UCase(strString)
    Exit Function
End If

Do While intPos > 0
    intLastPos = intPos
    intPos = InStr(intPos + 1, strString, " ")
Loop

GetLastName = UCase(Right(strString, Len(strString) - intLastPos)) & ", " & Left(strString, intLastPos - 1)

End Function

0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524320
(PS this should work fine in VB4)
0
 

Author Comment

by:dtucker
ID: 1524321
caref_g should get the points.
0
 
LVL 15

Expert Comment

by:ameba
ID: 1524322
Use GetTickCount, and tell us time to sort 7000 surnames.
0
 
LVL 15

Expert Comment

by:ameba
ID: 1524323
Anyway... if you were working for me and I found you using collection for this ... I would suggest you - use array

Get the Most Out of Your Arrays
You can sort one hundred thousand items in one second, if you use the right algorithm
0
 
LVL 7

Expert Comment

by:Vbmaster
ID: 1524324
Since I'm a so nice I'll post you my sort routine it's kinda of fast, at least I think so. It uses a non-recursive Quicksort algorithm optimized for speed in VB using a temporary Long Array (speeds up when I use it for xxxxxx items =)).

I haven't benchmarked it much so if any feels like it plz post me the result.


Sub QuickSort(ByRef X() As String)

  On Error GoTo ErrorHandler
 
  Dim Pos() As Long
  Dim Temp As Long
  Dim iLeft() As Long
  Dim iRight() As Long
  Dim i As Long
  Dim j As Long
  Dim sp As Long
  Dim Mid As Long
  Dim MidStr As String
  Dim Y() As String
  Dim Pivot As String
  Dim a As Long
  Dim xPosi As String
 
  ReDim Y(UBound(X))
  ReDim Pos(UBound(X))
  ReDim iLeft(UBound(X))
  ReDim iRight(UBound(X))
 
  For a = 1 To UBound(X)
    Pos(a) = a
    Y(a) = X(a)
    X(a) = LCase$(X(a))
  Next
 
  iLeft(1) = 1
  iRight(1) = UBound(X)
  sp = 1
 
  Do While (sp > 0)
    DoEvents
    If iLeft(sp) >= iRight(sp) Then
      sp = sp - 1
    Else
      i = iLeft(sp)
      j = iRight(sp)
      Pivot = X(Pos(j))
      Mid = (i + j) \ 2
      If (j - i) > 5 Then
        MidStr = X(Pos(Mid))
        xPosi = X(Pos(i))
        If (MidStr < Pivot) Then
          If (MidStr > xPosi) Then
            Temp = Pos(Mid)
            Pos(Mid) = Pos(j)
            Pos(j) = Temp
          ElseIf (xPosi < Pivot) And ((xPosi > MidStr)) Then
            Temp = Pos(i)
            Pos(i) = Pos(j)
            Pos(j) = Temp
          End If
        ElseIf (MidStr > Pivot) Then
          If (MidStr < xPosi) Then
            Temp = Pos(Mid)
            Pos(Mid) = Pos(j)
            Pos(j) = Temp
          ElseIf (xPosi > Pivot) And ((xPosi < MidStr)) Then
            Temp = Pos(Mid)
            Pos(Mid) = Pos(j)
            Pos(j) = Temp
          End If
        End If
      End If
      Pivot = X(Pos(j))
 
      Do While (i < j)
        Do While (X(Pos(i)) < Pivot)
          i = i + 1
        Loop
        j = j - 1
        Do While (i < j) And (Pivot < X(Pos(j)))
          j = j - 1
        Loop
        If (i < j) Then
          Temp = Pos(i)
          Pos(i) = Pos(j)
          Pos(j) = Temp
        End If
      Loop
   
      j = iRight(sp)
      Temp = Pos(i)
      Pos(i) = Pos(j)
      Pos(j) = Temp
     
      If i - iLeft(sp) >= iRight(sp) - i Then
        iLeft(sp + 1) = iLeft(sp)
        iRight(sp + 1) = i - 1
        iLeft(sp) = i + 1
      Else
        iLeft(sp + 1) = i + 1
        iRight(sp + 1) = iRight(sp)
        iRight(sp) = i - 1
      End If
      sp = sp + 1
    End If
  Loop

  For a = 1 To UBound(X)
    X(a) = Y(Pos(a))
  Next
 
ErrorHandler:

End Sub

0
 

Author Comment

by:dtucker
ID: 1524325
caraf_g gets the points
0
 

Author Comment

by:dtucker
ID: 1524326
This is to caraf_g: Using this code,    Private Function GetLastName(ByVal strString As String) As String

      Dim intPos As Integer
      Dim intLastPos As Integer

      intPos = InStr(strString, " ")

      If intPos = 0 Then
          GetLastName = UCase(strString)
          Exit Function
      End If

      Do While intPos > 0
          intLastPos = intPos
          intPos = InStr(intPos + 1, strString, " ")
      Loop

      GetLastName = UCase(Right(strString, Len(strString) - intLastPos)) & ", " & Left(strString,
      intLastPos - 1)

      End Function


I would like to count how many peoples last names are between a-l and m-z, but I don't know where to set the counters in this routine. Or is it in the BinarySearch(ByVal strString As String, lngIndex As Long, blnMatch As Boolean)
routine?
0
 
LVL 10

Accepted Solution

by:
caraf_g earned 1000 total points
ID: 1524327
Thanks dtucker!

Well, in my example I'm adding a name every time you click on the button. You'll probably have included that in some sort of loop. But, let's stick to my example - you can adapt it to your implementation.

I would put it in the button's _Click procedure:

(General Declarations)
lngTotalAL As Long
lngTotalMZ As Long

In Form_Load:
lngTotalAL = 0
lngTotalMZ = 0

In Command1_Click()
    If GetLastName(Text1.Text) <= "L" Then
        lngTotalAL = lngTotalAL + 1
    Else
        lngTotalMZ = lngTotalMZ + 1
    End If



Hope this helps!

Good luck

Pino
0
 

Author Comment

by:dtucker
ID: 1524328
Adjusted points to 250
0
 

Author Comment

by:dtucker
ID: 1524329
This is for caraf_g...
The code you have supplied so far was great... Now I have sorted to the listbox all my names into alphabetical order and now I want to make two random access datafiles out of the the first one a_thru_l.dat and last one m_thru_z.dat
I am using this code:

z = 1
recnum = 1
    For z = 1 To al% Step 1      ;number of records a thru l
    For recnum = 1 To lastrecord
  List1.ListIndex = 0
  List1.Selected(0) = True
 applicant$ = List1.Text ;getting the first applicants name
  Get #2, recnum, primequote; getting record from main database
If applicant$ = Trim(primequote.applicant) Then ; comparing the two and if it's the same then
 Put #1, currentrecord, primequote ;put into a_thru_l.dat
   List1.RemoveItem (0); remove from listbox
  Exit For;exit from looking for this record
  End If
  recnum = recnum + 1; go onto next record to see if it's the applicant
  Next recnum
 
  Next z;next name in listbox
This code dosn't seem to be working properly,
what am I doing wrong?
I will add more points for you when this question is answered.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524330
Can you tell me what your structure "primequote" looks like?
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524331
Sorry - I mean, can you give me your Type definition for "primequote"?
0
 

Author Comment

by:dtucker
ID: 1524332
Here is the Type definition of primequote:
Type primequoteinfo
    leadrecieved As String * 15
    agent As String * 30
    applicant As String * 30
    ssn As String * 15
    dob As String * 15
    address As String * 50
    city As String * 20
    state As String * 10
    zip As String * 10
    homephone As String * 20
    workphone As String * 20
    ext As String * 6
    besttime As String * 500
    notes As String * 500
    datecontacted As String * 15
    datesent As String * 15
    dateexam As String * 15
    dateappmedical As String * 15
    dateappsent As String * 15
    datepolicyreceived As String * 15
    insurance As String * 50
    policytype As String * 50
    deathbenefit As String * 20
    smoker As Integer
    rated As Integer
    nonsmoker As Integer
    notrated As Integer
    preset As String * 1000
    presetvalue As Integer
    premium As Currency
    premmode As String * 15
    commission As Currency
    paid1 As String * 15
    paid2 As String * 15
    paid3 As String * 15
    paid4 As String * 15
    paid5 As String * 15
    paid6 As String * 15
    paid7 As String * 15
    paid8 As String * 15
    paid9 As String * 15
    paid10 As String * 15
    paid11 As String * 15
    paid12 As String * 15
    sex As String * 10
    predate As String * 10
    arrncp As String * 50
 End Type

And I open up both files with:
Close
    sortrecordlen = Len(primequote)
    sortfilenum = 1
    Open "a_thru_l.pqd" For Random As sortfilenum Len = sortrecordlen
    recordlen = Len(primequote)
   
    filenum = 2
    Open chosenfile$ For Random As filenum Len = recordlen
    currentrecord = 1
    lastrecord = FileLen(chosenfile) / recordlen
        If lastrecord = 0 Then
        lastrecord = 1
    End If
Whenever I run the above sort program (that I added today to this question)
The first record gets put in the new database but thats all.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524333
OK, I've looked at the problem, and come up with a solution.

Again, I've based it on my original example, so you'll have to translate this into your example, but it shouldn't be too hard.

The trick is to use a class module, and a little bit of "object oriented" programming.

You can use the same form as with my first example. Also, add a class module into your project.

In the class module, paste the following:

0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524334
Option Explicit
Public strLastName As String
Public strMiddle As String
Public strFirstName As String
Public strFullName As String

0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524335
In the form module, paste the following, replacing all the existing code with new code:
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524336
Option Explicit
Dim objCollection As Collection
Private Type PrimeQuote
    strFirstName As String
    strMiddle As String
    strLastName As String
End Type
Private Sub Command1_Click()

Dim lngIndex As Long
Dim blnMatch As Boolean

Dim objPQ As clsPrimeQuote
Set objPQ = New clsPrimeQuote
objPQ.strFirstName = GetUnformattedFirstName(Text1.Text)
objPQ.strMiddle = GetUnformattedRemainder(Text1.Text)
objPQ.strLastName = GetUnformattedLastName(Text1.Text)
objPQ.strFullName = Text1.Text

BinarySearch objPQ, lngIndex, blnMatch

If lngIndex = 0 Then
    If objCollection.Count = 0 Then
        objCollection.Add objPQ
    Else
        objCollection.Add objPQ, , 1
    End If
Else
    objCollection.Add objPQ, , , lngIndex
End If

List1.Clear
For lngIndex = 1 To objCollection.Count
    Set objPQ = objCollection(lngIndex)
    List1.AddItem objPQ.strFullName
Next

Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)

End Sub

Private Sub BinarySearch(objPQ As clsPrimeQuote, lngIndex As Long, blnMatch As Boolean)

If objCollection Is Nothing Then
    Set objCollection = New Collection
    lngIndex = 0
    blnMatch = False
    Exit Sub
End If

Dim objCPQ As clsPrimeQuote

Set objCPQ = objCollection(1)
If UCase(objCPQ.strLastName & ", " & objCPQ.strFirstName & " " & objCPQ.strMiddle) > _
   UCase(objPQ.strLastName & ", " & objPQ.strFirstName & " " & objPQ.strMiddle) Then
    lngIndex = 0
    blnMatch = False
    Exit Sub
End If

Set objCPQ = objCollection(objCollection.Count)
If UCase(objCPQ.strLastName & ", " & objCPQ.strFirstName & " " & objCPQ.strMiddle) <= _
   UCase(objPQ.strLastName & ", " & objPQ.strFirstName & " " & objPQ.strMiddle) Then
    lngIndex = objCollection.Count
    blnMatch = False
    Exit Sub
End If

Dim lngStart As Long
Dim lngEnd As Long
Dim lngCurrent As Long

lngStart = 1
lngEnd = objCollection.Count
lngCurrent = (lngEnd + lngStart) \ 2
Do While lngStart < lngEnd - 1
    Set objCPQ = objCollection(lngCurrent)
    If UCase(objCPQ.strLastName & ", " & objCPQ.strFirstName & " " & objCPQ.strMiddle) <= _
       UCase(objPQ.strLastName & ", " & objPQ.strFirstName & " " & objPQ.strMiddle) Then
        lngStart = lngCurrent
    Else
        lngEnd = lngCurrent
    End If
    lngCurrent = (lngEnd + lngStart) \ 2
Loop

lngIndex = lngCurrent

End Sub


Private Function GetUnformattedLastName(ByVal strString As String) As String

Dim intPos As Integer
Dim intLastPos As Integer

intPos = InStr(strString, " ")

If intPos = 0 Then
    GetUnformattedLastName = strString
    Exit Function
End If

Do While intPos > 0
    intLastPos = intPos
    intPos = InStr(intPos + 1, strString, " ")
Loop

GetUnformattedLastName = Right(strString, Len(strString) - intLastPos)

End Function
Private Function GetUnformattedFirstName(ByVal strString As String) As String

Dim intPos As Integer

intPos = InStr(strString, " ")

If intPos = 0 Then
    GetUnformattedFirstName = ""
    Exit Function
End If

GetUnformattedFirstName = Left(strString, intPos - 1)

End Function
Private Function GetUnformattedRemainder(ByVal strString As String) As String

Dim intPos As Integer
Dim intLastPos As Integer
Dim intFirstPos As Integer

intPos = InStr(strString, " ")

If intPos = 0 Then
    GetUnformattedRemainder = ""
    Exit Function
End If

intFirstPos = intPos
Do While intPos > 0
    intLastPos = intPos
    intPos = InStr(intPos + 1, strString, " ")
Loop

If intFirstPos = intLastPos Then
    GetUnformattedRemainder = ""
    Exit Function
End If

GetUnformattedRemainder = Mid(strString, intFirstPos + 1, intLastPos - intFirstPos - 1)

End Function

0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524337
When you modify this to work with your code, your class module will look a lot like your PrimeQuote type. In actual fact you can interpret the clsPrimeQuote Class as an "object" interpretation of the Type PrimeQuote. In that sense, classes and types are very similar things.

But as you can see from my code, you can do wonderful things with class types, in conjunction with using a collection. That's where the real strength of this programming comes in.

Now to fixing your problem of writing the data files...
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524338
I would write something like the following. Remember, we've got a collection that contains all the entries, nicely sorted, and handily wrapped up in clsPrimeQuote objects...

'Declare an object of type clsPrimeQuote
Dim objPQ As clsPrimeQuote
'Declare a user-type variable of type PrimeQuote
Dim udtPQ As PrimeQuote

'blank out file before we start
Dim intFile As Integer
intFile = FreeFile
Open "yourFile" for Output As #intFile
Close #intFile

'Then open it for writing to:
intFile = FreeFile
Open "yourFile" For Random As #intFile Len = Len(udtPQ)

For z = 1 To al% Step 1      ;number of records a thru l
    Set objPQ = objCollection(z)
    'Now, transfer all the data to the udt variable:
    udtPQ.strFirstName = objPQ.strFirstName
    udtPQ.strMiddle = objPQ.strMiddle
    udtPQ.strLastName = objPQ.strLastName
    'Once you've done this, it is in a handy format to _
     write to your file. So you don't need to access the _
     original file again (as in your code).
    Put #intFile, ,udtPQ
Next z
Close #intFile

'Note that for correct results you must define the elements of PrimeQuote as fixed strings - but I see you've done this so you're OK.

0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524339
Hope this helps!

Good luck

Pino
0
 

Author Comment

by:dtucker
ID: 1524340
To caraf_g,
Help... with the above code I get the error, User Defined Type not defined error with the lines:
Dim objPQ As clsPrimeQuote
Dim udtPQ As primequote
and the routine:
Private Sub binarysrch(objPQ As clsPrimeQuote, lngIndex As Long, blnMatch As Boolean)
What do I need to change to fix this...
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524341
Hi dtucker,

Start with my comment of
Wednesday, July 14 1999 - 03:04PM PDT  

So
1 - create a class module, and paste in the code (4 lines)
    You'll need to go into the properties for the class module, and make sure it's called clsPrimeQuote
2 - paste the code from
Date: Wednesday, July 14 1999 - 03:05PM PDT  into the form module, replacing existing code.

3 - now if you use the code of
Wednesday, July 14 1999 - 03:19PM PDT
it should no longer come up with those errors.

Good luck

Pino

0
 

Author Comment

by:dtucker
ID: 1524342
To caraf_g,
I am still having a problem with the line:
Dim udtPQ As PrimeQuote
Giving me the same error, I think it's because I use primequote as another variable, as everytime I try to capitalize the P and Q they convert to small case.
When I change the line to read:
Dim udtPQ As udt PrimeQuote
The case dosn't change but I still get the same error.
I couldn't paste the code in yet to replace mine because I did alot of changing to get it to do things that I needed, I simpley added the different routines that were different and changed BinarySearch routine to BnrySearch and fixed the line calling it in order to keep both the routines. And once I get you new routine running and doing what I need it to do then I will weed out what's not needed.
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1524343
Ah, I see. Ok, I'm talking about my example, but you're already implementing it in your program. That's fine, but just be aware that I've defined a type named
PrimeQuote in my example.

Your best bet is to change the type declaration
in my example I declared it as
Private Type PrimeQuote
    strFirstName As String
    strMiddle As String
    strLastName As String
End Type

In your case it will be a lot longer. But I would do
Private Type dtuckerPrimeQuote 'for example
    strFirstName As String
    strMiddle As String
    strLastName As String
End Type

And everywhere where in my code I did something like
Dim udtPQ As PrimeQuote
replace that with
Dim udtPQ As dtuckerPrimeQuote

And that should get you around that problem.

Good luck

Pino
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

660 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question