Simple (?) Alphabetic Listing

[MikSwor]

Sheet 1 (a sign up sheet) looks like this:
A_______B________C__________D__________E
8:00__B. Jones__Fred Fox__Fred Farel_R McDow
8:30__Al Smith__Mike Brown___________Ti Smith
9:00____________Mary Allyn

I would like sheet 2 to be an alpa list:
A________B
9:00___Mary Allyn
8:30___Mike Brown
8:00___Fred Farel
8:00___Fred Fox
8:00___B. Jones
8:00___R McDow
8:30___Al Smith
8:30___Ti Smith

(The lines ____ are just there to space things out for this posting.)
This type of listing has probably been done thousands of times, by thousands of people.
However, I am having problems with things like sorting the blank spaces and generally staying out of trouble. Is there some sort of easy macro that can make the process "automatic" rather than a series of tedious excel steps? My actual listing can have up to 128 names per day, luckily there are lots of blank slots.
Thanks for any help/advice.
Mike

[ This Message was edited by: MikSwor on 2002-03-26 08:04 ]

[Tom Schreiner]

Hi
This should help you out.
Copy this into a standard module
Create a button if you know how and name it cmdSend_N_Sort or click F8 to show the list of macros.
Unless you can edit the code, your data will need to follow some parameters.

On sheet1 is where the first list needs to be placed.

Column A = Time
Col B,C,D are for the names.
Start on row 3
This program will search down to Row 1000
Seeing that the last names are not listed
first, the list cannot be sorted the usual way. So the code looks for a space and uses the next letter found. If there is no space between the first and last name then that name will be sorted to the bottom of the list. The list is sent to sheet2
I reccomend that you start with a new workbook. All the sheet references will default to being correct.

Have a nice day!

Tom

Sub cmdSend_N_Sort_Click()
Dim ColCntr As Integer
Dim RowCntr As Long
Dim SendRowCntr As Long
Dim AddNewRow As Boolean
Dim LastNameFind As Integer
Dim SchdName As String

Sheet1.Activate
SendRowCntr = 2
For RowCntr = 3 To 1000
For ColCntr = 2 To 5
If Sheet1.Cells(RowCntr, ColCntr).Value <> "" Then
SendRowCntr = SendRowCntr + 1
Sheet2.Cells(SendRowCntr, 1).Value = _
Sheet1.Cells(RowCntr, 1).Value
Sheet2.Cells(SendRowCntr, 2).Value = _
Sheet1.Cells(RowCntr, ColCntr).Value
End If
Next
Next

Sheet2.Activate

For RowCntr = 3 To SendRowCntr
SchdName = Trim(Sheet2.Cells(RowCntr, 2).Value)
LastNameFind = InStr(SchdName, " ")
LastNameFind = LastNameFind + 1
If Mid(SchdName, LastNameFind, 1) <> " " Then
Sheet2.Cells(RowCntr, 3).Value = Trim(Mid(SchdName, LastNameFind, 5))
Else
If Mid(SchdName, LastNameFind + 1, 1) <> " " Then _
Sheet2.Cells(RowCntr, 3).Value = Trim(Mid(SchdName, LastNameFind, 5))
End If
Next
Sheet2.Range("A3:D1000").Sort Key1:=Sheet2.Range("C3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Sheet2.Range("C1:C1000").ClearContents

End Sub




[ This Message was edited by: TsTom on 2002-03-26 17:00 ]

[MikSwor]

Thanks Tom,
Solution wasn't as simple as I thought it should be. I'll give it a go this weekend.
I'm just finishing a visual basic class so the command button and coding should give me no problems.
Happy Easter
Mike

[ This Message was edited by: MikSwor on 2002-03-26 20:12 ]

[Tom Schreiner]

Hi
Solution may actually be much simpler than what I gave you. All I know is that it works.
Have a limited vocabulary in VBA, but am good at finding a way to make things work.
HAve a good day!
Tom