| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Smart four digit sorting procedure
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
Thank you.
Would it be possible just to sort the three coulums without automatically finding the the oldest version and copy into the column right next to it, and without printing all those numbers? Just sorting the list based on the four digits and then based on date, but this time sorting the files in a decending manner (the code you gave me puts the oldest version on top) -- Kind regards, Nic "Joel" wrote: 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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
I made the following changes
1) Found a better way of finding the 4 digit numbers. Much simplier method 2) Perfoprm the data sort descending instead of ascending 3) Put the numbers in column IV, then deleted column IV. You need to put ther 4 digit number into the worksheet to perform the sort. Then you can delete the numbers at the end of the macro. You will nevver know the numbers where placed in the worksheet when the macro completes. 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) If IsNumeric(Mid(MyStr, CharCount, 4)) Then Number = Mid(MyStr, CharCount, 4) Range("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount 'delete the 4 digit numbers in column IV Columns("IV").Delete End Sub "Nic Daniels" wrote: Thank you. Would it be possible just to sort the three coulums without automatically finding the the oldest version and copy into the column right next to it, and without printing all those numbers? Just sorting the list based on the four digits and then based on date, but this time sorting the files in a decending manner (the code you gave me puts the oldest version on top) -- Kind regards, Nic "Joel" wrote: 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 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
Hi, This new code does not do its job. 26.01.2007 12:25 9.9M-1112 rev 2.pdf 28.02.2007 11:09 9.9M-1102 rev 5.pdf 28.02.2007 11:10 9.9M-1104 rev 4.pdf 22.06.2006 18:15 9.9M-1010.pdf 14.08.2006 15:28 ucr0001sh3-3.pdf 29.01.2007 14:39 ucP0003_13-4.pdf 30.04.2007 14:13 99m0008_1-2.pdf 30.04.2007 14:13 99m0008_2-2.pdf 06.10.2006 15:38 99m0008 rev1 com.pdf 06.10.2006 10:13 99m0008_1-1.pdf 06.10.2006 10:13 99m0008_2-1.pdf The old code you gave me could sort the four digits independently of where the were in the file name, but now it does not. The above list is sorted using your new code. The files with a capital M are on top. Kind regards, Nic "Joel" wrote: I made the following changes 1) Found a better way of finding the 4 digit numbers. Much simplier method 2) Perfoprm the data sort descending instead of ascending 3) Put the numbers in column IV, then deleted column IV. You need to put ther 4 digit number into the worksheet to perform the sort. Then you can delete the numbers at the end of the macro. You will nevver know the numbers where placed in the worksheet when the macro completes. 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) If IsNumeric(Mid(MyStr, CharCount, 4)) Then Number = Mid(MyStr, CharCount, 4) Range("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount 'delete the 4 digit numbers in column IV Columns("IV").Delete End Sub "Nic Daniels" wrote: Thank you. Would it be possible just to sort the three coulums without automatically finding the the oldest version and copy into the column right next to it, and without printing all those numbers? Just sorting the list based on the four digits and then based on date, but this time sorting the files in a decending manner (the code you gave me puts the oldest version on top) -- Kind regards, Nic "Joel" wrote: 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 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
I didn't realize that VBA treated a dash as a negative sign. The following is false isnumeric("-") A dash by itself is not considered numeric The following is numeric isnumeric("-111) The original ode worked because the dash by itself wasn't numeric. The new code considered the "-111 as numeric. You wanted to sort by "1112" not "-111". 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("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount Columns("IV").Delete End Sub "Nic Daniels" wrote: Hi, This new code does not do its job. 26.01.2007 12:25 9.9M-1112 rev 2.pdf 28.02.2007 11:09 9.9M-1102 rev 5.pdf 28.02.2007 11:10 9.9M-1104 rev 4.pdf 22.06.2006 18:15 9.9M-1010.pdf 14.08.2006 15:28 ucr0001sh3-3.pdf 29.01.2007 14:39 ucP0003_13-4.pdf 30.04.2007 14:13 99m0008_1-2.pdf 30.04.2007 14:13 99m0008_2-2.pdf 06.10.2006 15:38 99m0008 rev1 com.pdf 06.10.2006 10:13 99m0008_1-1.pdf 06.10.2006 10:13 99m0008_2-1.pdf The old code you gave me could sort the four digits independently of where the were in the file name, but now it does not. The above list is sorted using your new code. The files with a capital M are on top. Kind regards, Nic "Joel" wrote: I made the following changes 1) Found a better way of finding the 4 digit numbers. Much simplier method 2) Perfoprm the data sort descending instead of ascending 3) Put the numbers in column IV, then deleted column IV. You need to put ther 4 digit number into the worksheet to perform the sort. Then you can delete the numbers at the end of the macro. You will nevver know the numbers where placed in the worksheet when the macro completes. 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) If IsNumeric(Mid(MyStr, CharCount, 4)) Then Number = Mid(MyStr, CharCount, 4) Range("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount 'delete the 4 digit numbers in column IV Columns("IV").Delete End Sub "Nic Daniels" wrote: Thank you. Would it be possible just to sort the three coulums without automatically finding the the oldest version and copy into the column right next to it, and without printing all those numbers? Just sorting the list based on the four digits and then based on date, but this time sorting the files in a decending manner (the code you gave me puts the oldest version on top) -- Kind regards, Nic "Joel" wrote: 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 |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
Great! It works perfectly fine! Thanks. -- Kind regards, Nic "Joel" wrote: I didn't realize that VBA treated a dash as a negative sign. The following is false isnumeric("-") A dash by itself is not considered numeric The following is numeric isnumeric("-111) The original ode worked because the dash by itself wasn't numeric. The new code considered the "-111 as numeric. You wanted to sort by "1112" not "-111". 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("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount Columns("IV").Delete End Sub "Nic Daniels" wrote: Hi, This new code does not do its job. 26.01.2007 12:25 9.9M-1112 rev 2.pdf 28.02.2007 11:09 9.9M-1102 rev 5.pdf 28.02.2007 11:10 9.9M-1104 rev 4.pdf 22.06.2006 18:15 9.9M-1010.pdf 14.08.2006 15:28 ucr0001sh3-3.pdf 29.01.2007 14:39 ucP0003_13-4.pdf 30.04.2007 14:13 99m0008_1-2.pdf 30.04.2007 14:13 99m0008_2-2.pdf 06.10.2006 15:38 99m0008 rev1 com.pdf 06.10.2006 10:13 99m0008_1-1.pdf 06.10.2006 10:13 99m0008_2-1.pdf The old code you gave me could sort the four digits independently of where the were in the file name, but now it does not. The above list is sorted using your new code. The files with a capital M are on top. Kind regards, Nic "Joel" wrote: I made the following changes 1) Found a better way of finding the 4 digit numbers. Much simplier method 2) Perfoprm the data sort descending instead of ascending 3) Put the numbers in column IV, then deleted column IV. You need to put ther 4 digit number into the worksheet to perform the sort. Then you can delete the numbers at the end of the macro. You will nevver know the numbers where placed in the worksheet when the macro completes. 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) If IsNumeric(Mid(MyStr, CharCount, 4)) Then Number = Mid(MyStr, CharCount, 4) Range("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount 'delete the 4 digit numbers in column IV Columns("IV").Delete End Sub "Nic Daniels" wrote: Thank you. Would it be possible just to sort the three coulums without automatically finding the the oldest version and copy into the column right next to it, and without printing all those numbers? Just sorting the list based on the four digits and then based on date, but this time sorting the files in a decending manner (the code you gave me puts the oldest version on top) -- Kind regards, Nic "Joel" wrote: 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, _ |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Smart four digit sorting procedure
Since you have 3 sheets it is better to specify the sheet name. Look at the code below Sub SortNumbers() With Sheets("Sheet1") 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("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data .Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=.Range("IV1"), _ order1:=xlAscending, _ key2:=.Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved .Range("D1") = .Range("C1") For RowCount = 2 To LastRow If .Range("IV" & RowCount) < .Range("IV" & (RowCount - 1)) Then .Range("D" & RowCount) = .Range("C" & RowCount) Else .Range("D" & RowCount) = .Range("IV" & (RowCount - 1)) End If Next RowCount .Columns("IV").Delete End With End Sub "Nic Daniels" wrote: Great! It works perfectly fine! Thanks. -- Kind regards, Nic "Joel" wrote: I didn't realize that VBA treated a dash as a negative sign. The following is false isnumeric("-") A dash by itself is not considered numeric The following is numeric isnumeric("-111) The original ode worked because the dash by itself wasn't numeric. The new code considered the "-111 as numeric. You wanted to sort by "1112" not "-111". 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("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount Columns("IV").Delete End Sub "Nic Daniels" wrote: Hi, This new code does not do its job. 26.01.2007 12:25 9.9M-1112 rev 2.pdf 28.02.2007 11:09 9.9M-1102 rev 5.pdf 28.02.2007 11:10 9.9M-1104 rev 4.pdf 22.06.2006 18:15 9.9M-1010.pdf 14.08.2006 15:28 ucr0001sh3-3.pdf 29.01.2007 14:39 ucP0003_13-4.pdf 30.04.2007 14:13 99m0008_1-2.pdf 30.04.2007 14:13 99m0008_2-2.pdf 06.10.2006 15:38 99m0008 rev1 com.pdf 06.10.2006 10:13 99m0008_1-1.pdf 06.10.2006 10:13 99m0008_2-1.pdf The old code you gave me could sort the four digits independently of where the were in the file name, but now it does not. The above list is sorted using your new code. The files with a capital M are on top. Kind regards, Nic "Joel" wrote: I made the following changes 1) Found a better way of finding the 4 digit numbers. Much simplier method 2) Perfoprm the data sort descending instead of ascending 3) Put the numbers in column IV, then deleted column IV. You need to put ther 4 digit number into the worksheet to perform the sort. Then you can delete the numbers at the end of the macro. You will nevver know the numbers where placed in the worksheet when the macro completes. 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) If IsNumeric(Mid(MyStr, CharCount, 4)) Then Number = Mid(MyStr, CharCount, 4) Range("IV" & RowCount) = Number Exit For End If Next CharCount Next RowCount 'sort data Rows("1:" & LastRow).Sort _ Header:=xlNo, _ key1:=Range("IV1"), _ order1:=xlAscending, _ key2:=Range("A1"), _ order2:=xlDescending 'move first item to column b 'first row always gets moved Range("D1") = Range("C1") For RowCount = 2 To LastRow If Range("IV" & RowCount) < Range("IV" & (RowCount - 1)) Then Range("D" & RowCount) = Range("C" & RowCount) Else Range("D" & RowCount) = Range("IV" & (RowCount - 1)) End If Next RowCount 'delete the 4 digit numbers in column IV Columns("IV").Delete End Sub "Nic Daniels" wrote: Thank you. Would it be possible just to sort the three coulums without automatically finding the the oldest version and copy into the column right next to it, and without printing all those numbers? Just sorting the list based on the four digits and then based on date, but this time sorting the files in a decending manner (the code you gave me puts the oldest version on top) -- Kind regards, Nic "Joel" wrote: 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Sorting by last digit | Excel Worksheet Functions | |||
| Sorting by 5 digit & 5 digit plus 4 zip codes | Excel Worksheet Functions | |||
| Sorting a six digit number by terminal digit | Excel Worksheet Functions | |||
| sorting alpha numeric list by first left digit | New Users to Excel | |||
| 12 digit code sorting | Excel Worksheet Functions | |||
Linear Mode
