PDA

View Full Version : Solved: Sorting A1 through A10...



thomaspatton
02-29-2008, 11:15 AM
...and I'm not referring to the cell references. I'm talking about cell values.

Private Sub cmdAPCSeatSort_Click()
With Worksheets("Class Information")
.Range("A18:P75").Sort _
Key1:=.Range("P18"), Order1:=xlDescending, _
Key2:=.Range("A18"), Order2:=xlAscending, _
Header:=xlNo
End With
UserForm4.Hide
End Sub

There's my sort code I'm working with. P18.value is either yes or no (user input). A18 is where I'm running into a problem. Column A contains seating numbers in relation to our classroom setup. A1 through A10, B1 through B10... so on,so forth. Can you guess what's happening when I sort Column A?

A1
A10
A2
A3
A4
A5
A6
A7
A8
A9

Yup. How can I work around this? I would say, "just don't sort the column", but after a student is assigned the seat they're stuck with, alphabetical order or not. I'll throw my book on in case you need a peak at something.

XLD! Help me bro!

P.S. - Or anyone knowing a solution to this issue.

Bob Phillips
02-29-2008, 11:39 AM
Private Sub cmdAPCSeatSort_Click()
Dim LastRow As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Class Information")

.Columns("B:C").Insert
.Range("C18:C75").Formula = "=LOOKUP(99^99,--(""0""&MID(A18,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A18&""0123456789"")),ROW(INDIRECT(""1:""&LEN(A18))))))"
.Range("B18:B75").Formula = "=SUBSTITUTE(A18,C18,"""")"
.Range("A18:R75").Sort _
Key1:=.Range("P18"), Order1:=xlDescending, _
Key2:=.Range("B18"), Order2:=xlAscending, _
Key3:=.Range("C18"), Order3:=xlAscending, _
Header:=xlNo
.Columns("B:C").Delete
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

UserForm4.Hide
End Sub

thomaspatton
02-29-2008, 12:09 PM
You have got to be kidding me! I figured there was a simpler solution that I had overlooked...

And I'm guessing since I have user input information in Columns A through P, I would have to change .Range(C and .Range(B to something like .Range(Z and .Range(AA ? Is that correct and will it affect the code in anyway. I'll be honest with ya... I have no idea what the hell that code does >.o

And also, what's the purpose of "dim LastRow as Long" if it's not being called?

Bob Phillips
02-29-2008, 12:51 PM
You have got to be kidding me! I figured there was a simpler solution that I had overlooked...

Now why would I do that? It is Excel's built-in sort order, it is just following it. It isn't very complex, just a simple insert, formula, and sort on the new columnd, delete them.


And I'm guessing since I have user input information in Columns A through P, I would have to change .Range(C and .Range(B to something like .Range(Z and .Range(AA ? Is that correct and will it affect the code in anyway. I'll be honest with ya... I have no idea what the hell that code does >.o

No I took care of that when I sort A:R, not A:P now.

See above for what it does.


And also, what's the purpose of "dim LastRow as Long" if it's not being called?

Built-in redundancy.

Ar first I assumed that I would work out the last row, then I noticed you hard-defined it as 75.

thomaspatton
02-29-2008, 01:05 PM
Now why would I do that? It is Excel's built-in sort order, it is just following it. It isn't very complex, just a simple insert, formula, and sort on the new columnd, delete them.

Just because maybe I HAD overlooked something miniscule and you tire of the redundancy of some of these questions and chose to humor yourself. :devil2:



No I took care of that when I sort A:R, not A:P now.

See above for what it does.

You owned me... on a horrible level. I completely overlooked the .Insert and .Delete portion of the column code.

Now, that formula is what blows my mind. I thought I was pretty good with Excel formulae... guess I'll just go back to thinking I'm better than the 2 finger typer until I can translate that monster. I'm gonna be sitting here for hours in MSHelp breaking those 2 lines down piece by piece. :rotlaugh:
Thanks, once again, XLD.

Oh yeah, and it works great.

Bob Phillips
02-29-2008, 02:06 PM
The formula is probably overkill, I assumed that A1,A2 were examples and the real data was more varied. But I'll try and explain it for you.

The principle is to look for the first number and extract every string increasing the number of characters extracted, always starting at that number. As it is possible that the string has no numbers, a string of all numeric digits is appended to avoid errors

A1&"0123456789"

The first digit is looked for withinthis extended string

SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")

We get the position of the first number within this extended string

MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))

We then need to get all of the numeric strings, wherein lies the difficulty, and where we use the old ROW(INDIRECT trick, building an array of lengths from 1 to the length of A1 (this may be more than we need if it starts with letters, but will never be less).

Combine these and we can get an array of all of the numeric strings using

MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),ROW(INDIRECT("1:"&LEN(A1))))

we prefix with 0 in case it is all non-numeric,a nd use -- to coerce to numbers.

And finally we use LOOKUP with a big number, 99^99, knowing that none of the numbers in our array will be that big, so it will return the largets less than that big number

=LOOKUP(99^99,--("0"&MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),ROW(INDIRECT("1:"&LEN(A1))))))

As an example, suppose we have abc123 in A1.Then

A1&"0123456789" resolves to "abc1230123456789"

SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789") resolves to an array {7,4,5,6,11,12,13,14,15,16} - the 4,5,6 are the positions of our digits 1,2,3

MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")) then returns 4, the position of the first digit, the 1 in our example

MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),ROW(INDIRECT("1:"&LEN(A1)))) then returns an array of all numeric strings startaing at the first digit, {"1";"12";"123";"123";"123";"123"}

--("0"&MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),ROW(INDIRECT("1:"&LEN(A1))))) changes that array to an array of numbers, {1;12;123;123;123;123}

=LOOKUP(99^99,--("0"&MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),ROW(INDIRECT("1:"&LEN(A1)))))) returns our answer, 123, the largest value within the array

thomaspatton
02-29-2008, 02:09 PM
Thanks!

tstav
02-29-2008, 03:03 PM
Hi thomaspatton,
I liked your excel sheet, very neat work indeed. And the way you have written the names e.g. Patton A,B,C,... helped a lot to check whether the sort succeeded.
Here's my version for the same job (if you're still interested)
Sub SortingSeats()
'''''''''''''''''''''''''''''''''''''''''''''''''
'1.Data starts on row 18. Data ends on col 16 (P).
'2.Preferably we will locate the last seat row.
'Steps:
'Temporarily turn all seats to three-char strings
'Do the sort
'Restore seats to original string format
'''''''''''''''''''''''''''''''''''''''''''''''''
Dim Sht As Worksheet
Dim seatsRange, dataRange As Range
Dim lastRow, seatRow As Integer
Dim seatNum As String
Set Sht = ThisWorkbook.Worksheets("Class Information")

lastRow = Sht.Cells(Rows.Count, 1).End(xlUp).Row
'Set the Range that contains all the data to be sorted
Set dataRange = Sht.Range(Cells(18, 1), Cells(lastRow, 16))

'Turn all seats to 3-char (insert middle zero).
'We don't want any leading/trailing blanks here, so some validation
'is in order...
With Sht
For seatRow = 18 To lastRow
seatNum = Trim(.Cells(seatRow, 1).Value)
If Len(seatNum) < 3 Then
'Add a zero as the middle character e.g. A01, B01
seatNum = Left(seatNum, 1) & "0" & Right(seatNum, 1)
'Write the new seat
.Cells(seatRow, 1).Value = seatNum
End If
Next 'seatRow
End With

'Do the sort
With dataRange
.Sort _
Key1:=.Range("P18"), Order1:=xlDescending, _
Key2:=.Range("A18"), Order2:=xlAscending, _
Header:=xlNo
End With

'Restore all seats to original
'string format (eliminate middle zero)
With Sht
For seatRow = 18 To lastRow
seatNum = .Cells(seatRow, 1).Value
If Mid(seatNum, 2, 1) = "0" Then
'Eliminate the middle zero
seatNum = Left(seatNum, 1) & Right(seatNum, 1)
'Write the new seat
.Cells(seatRow, 1).Value = seatNum
End If
Next 'seatRow
End With

'Note:
'Actually the leading/trailing blanks validation is good only
'for the first time, since it eliminates them once they are found
'Count off the comment lines and you're left with just
'30 lines of readable code (at least that's what I think...).
'Icouldhavewrittenitthisway,butnomatterhowbrilliantitmightbe
'Idon'tthinkitwouldbethesame,communicationwise...
End Sub

thomaspatton
03-07-2008, 08:33 AM
Thanks

thomaspatton
03-07-2008, 08:35 AM
Thanks for the feedback on the sheet Tstav. And, I really should have thought about that code on my own... especially since I was sitting there THINKING "If I could just change the seat numbers in the classroom to A01, A02, etc it would solve this problem" ... and I even use Left & Right other places in my book... Owned once again...

And, btw, no slam to XLD because he's been the man since I came here, but your code is better imo, or at least for my App. Nice clean and to the point. Thanks alot!