View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Smart four digit sorting procedure

Try this

Sub SortNumbers()


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = Range("C" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
Range("E" & RowCount) = Number
Exit For
End If
Next CharCount
Next RowCount

'sort data
Rows("1:" & LastRow).Sort _
Header:=xlNo, _
key1:=Range("E1"), _
order1:=xlAscending, _
key2:=Range("A1"), _
order2:=xlAscending

'move first item to column b
'first row always gets moved
Range("D1") = Range("C1")
For RowCount = 2 To LastRow
If Range("E" & RowCount) < Range("E" & (RowCount - 1)) Then
Range("D" & RowCount) = Range("C" & RowCount)
Else
Range("D" & RowCount) = Range("E" & (RowCount - 1))
End If
Next RowCount


End Sub





"Nic Daniels" wrote:

You're brilliant! Thanks! What if you add some information:

08.07.2008 10:20 99m0059-0.pdf
30.08.2006 12:59 99m0059-1.pdf
04.06.2008 11:25 99m0060_1-0.pdf
30.08.2006 12:59 99m0060_1-1.pdf
04.06.2008 11:25 99m0060_2-0.pdf
30.08.2006 12:59 99m0060_2-1.pdf
04.06.2008 11:25 99m0062-0.pdf
30.08.2006 12:59 99m0062-1.pdf

This time you sort according to the four digits and then according to row A
(dates), the results would be:

08.07.2008 10:20 99m0059-0.pdf
30.08.2006 12:59 99m0059-1.pdf
04.06.2008 11:25 99m0060_1-0.pdf
04.06.2008 11:25 99m0060_2-0.pdf
30.08.2006 12:59 99m0060_1-1.pdf
30.08.2006 12:59 99m0060_2-1.pdf
04.06.2008 11:25 99m0062-0.pdf
30.08.2006 12:59 99m0062-1.pdf

The first file with a unique four digit number in the "sorted column" is
copied into a "new" column etc (like you did in the previous example)...

Since you seem to know it all, I was wondering if the "new" column could
then be sorted into another column without any gaps:

Ex:
"New" column
99m0039-0.pdf 99m0039-0.pdf 39
99m0039-A.pdf 39
99m0039-B.pdf 39
99m0039-C.pdf 39
99m0039-D.pdf 39
99m0044-1.pdf 99m0044-1.pdf 44
99m0044-2.pdf 44
99m0044-3.pdf 44
99m0045_1-1.pdf 99m0045_1-1.pdf 45

Result in a column next to it (without gaps etc):
99m0039-0.pdf 39
99m0044-1.pdf 44
99m0045_1-1.pdf 45



--
Kind regards, Nic


"Joel" wrote:

I put the 4 digit number in columnm C and then sorted by Columns C and Column
A.

Sub SortNumbers()


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = Range("A" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
Range("C" & RowCount) = Number
Exit For
End If
Next CharCount
Next RowCount

'sort data
Rows("1:" & LastRow).Sort _
header:=xlNo, _
key1:=Range("C1"), _
order1:=xlAscending, _
key2:=Range("A1"), _
order2:=xlAscending

'move first item to column b
'first row always gets moved
Range("B1") = Range("A1")
For RowCount = 2 To LastRow
If Range("C" & RowCount) < Range("C" & (RowCount - 1)) Then
Range("B" & RowCount) = Range("A" & RowCount)
End If
Next RowCount


End Sub


"Nic Daniels" wrote:

Hi,

I was wondering if there is any smart way you can sort lists of numbers with
some common features:

Ex:

99a0022-D.pdf
99a3065_2-3.pdf
9.9A-3068 Steel Structure
9.9A-3068 Steel Structure for GGH
99a3068 rev 4com.pdf
99a3068-1_1.pdf


You may notice that there are four digits in all of these files. However,
they are in different positions making the built in sorting function useless.
Is there any smart way to sort them according to the four digits and then
(the following numbers/letters) based on normal rules applied when sorting?



When this is done (I trust that you can help me!), Id like each file (the
ones first in line) with a unique four digit set to be copied into the row to
the right.


Ex:
99a0019_1-1.pdf 99a0019_1-1.pdf
99a0019_2-1.pdf
99a0021_1-1.pdf 99a0021_1-1.pdf
99a0021_2-1.pdf
99a0022-0.pdf 99a0022-0.pdf
99a0022-1.pdf
9.9A-3068 Steel Structure for A 9.9A-3068 Steel Structure for A
9.9A-3068 Steel Structure for B


Thank you! I look forward to hearing some smart ideas.

--
Kind regards, Nic