Sorting with a macro or a formula

[Guest]

In the data below, I need to be able to sort or divide, which ever term
represents having a formula or a macro automatically look at the data and
only allow the five most recent occurances of each row that have the unique
value in column 3. And, to make it more complicated, if there is not five
occurrances, then place the appropriate amount of rows after the last
occurrance to make it five. You can see, that the column with the value
OPTION has 9 occurances and need to be reduced to five by deleting everything
before 11/07/2006 where the value CRAFT only has 3 and needs to have 2 blank
rows added after 12/05/2006. In reality there are hundreds of these rows and
the amounts vary from 25 unique rows to sometime only 1. Any help would be
greatly appreciated. There is a header row I did not put in the example.


28 12/29/2006 Option D 6.00 0.00
55 12/18/2006 Option D 6.00 0.00
41 12/02/2006 Option D 6.00 0.00
56 11/18/2006 Option D 6.50 0.00
52 11/07/2006 Option D 8.00
19 10/22/2006 Option D 6.50 0.00
56 05/01/2006 Option T 7.50 0.00
74 04/21/2006 Option D 6.50 0.00
48 04/02/2006 Option A 8.50 4.80
48 12/18/2006 Take D 6.00 0.00
64 11/24/2006 Take D 6.50 0.00
54 10/22/2006 Take D 6.50 0.00
63 10/07/2006 Take D 6.00 0.00
63 08/14/2006 Take D 5.50 0.00
59 06/05/2006 Take D 6.00 0.00
52 05/13/2006 Take D 6.50 0.00
65 04/29/2006 Take D 6.00 0.00
63 04/01/2006 Take D 6.00 0.00
998 12/29/2006 Craft D 6.50 0.00
50 12/18/2006 Craft D 6.00 0.00
53 12/05/2006 Craft T 8.00 5.60
19 08/05/2006 New D 5.50 0.00
10 07/17/2006 New D 6.00
36 06/12/2006 New D 5.50 0.00
61 05/30/2006 New D 6.00 0.00
57 04/30/2006 New D 6.00 0.00
51 12/09/2006 Double Option D 6.50 0.00
55 11/17/2006 Double Option D 6.00
43 10/21/2006 Double Option D 5.50 0.00
53 08/28/2006 Double Option D 6.00 0.00
70 07/25/2006 Double Option D 6.00 0.00
50 07/10/2006 Double Option D 5.50 0.00
52 06/20/2006 Double Option D 5.50
47 06/06/2006 Double Option D 6.00 0.00

 

[Guest]

Quite tricky and required some head scratching...

Try the following macro. Adjust the sheet name as necessary:

Sheets("Data").Select
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
TestRow = 2
Do Until Cells(TestRow, 2) = ""
Match = Cells(TestRow, 3)
For i = 1 To 4 'Check for four repeats
If Cells(TestRow + i, 3) <> Match Then
Exit For
End If
Next i
If i < 5 Then 'Less than five repeats
TestRow = TestRow + i
For InsertRows = i + 1 To 5
Rows(TestRow).Select
Selection.Insert Shift:=xlDown
TestRow = TestRow + 1
Next InsertRows
Else 'Five or more repeats
TestRow = TestRow + i
Do While Cells(TestRow, 3) = Match
Rows(TestRow).Select
Selection.Delete
Loop
End If
Loop
End Sub

Don't forget to make a back-up copy of the data before executing the macro
as it deletes rows.

Regards,

ChristopherTri

 

[Guest]

Christopher, thanks a ton. I couldn't get it to work right probably because
I thought it would help if I condensed the actual data I would be able to
apply the correct fields to the fields that are in the macro. Well I
couldn't and so here is the actual data set. This data keeps on going and
going and the name is the only unique field that is the field used to
determine how many records of there are that are either more or less than
five records. Sorry if this caused you to waste any time. Thanks again.
Row 1 is the header. Also the sheet name is WiseG


a b c d e f g h i j k l m
n o p q r
1 Rec RC Name Trak Trk Date Sur Bey Dis 1c 2c 3c sc fi 1cc 2cc 3cc
fin
2 1 1 Annie EmD fst 03/22 D 58 8 1 40 50 2 5 13 46
32 23
3 1 1 Annie EmD fst 04/22 D 53 8 4 50 50 2 5 23 46
33 23
4 1 1 Annie EmD fst 06/22 D 58 8 1 50 50 2 5 26 46
34 23
5 1 1 Annie EmD fst 07/22 D 56 8 1 50 50 2 5 22 46
35 23
6 1 1 Annie EmD fst 09/21 D 58 8 1 50 50 2 5 11 46
36 23
7 1 1 Annie EmD fst 09/23 D 58 8 1 50 50 2 5 23 46
40 23
8 1 1 Oscar EmD fst 09/12 D 58 8 1 50 50 2 5 23 46
33 13
9 1 1 Oscar EmD fst 06/12 D 58 8 1 50 50 4 5 23 66
33 22
10 1 1 Oscar EmD fst 05/12 D 58 8 1 50 50 9 5 23 77
33 27
11 1 1 Oscar EmD fst 09/16 D 58 8 1 50 50 1 5 23 46
33 23
12 1 1 Oscar EmD fst 05/12 D 58 8 1 50 50 9 5 23 77
33 27
13 1 1 Tim EmD fst 09/16 D 58 8 1 50 50 1 5 23 46
33 23
14 1 1 Tim EmD fst 05/12 D 58 8 1 50 50 9 5 23 77
33 27
15 1 1 Tim EmD fst 09/16 D 58 8 1 50 50 1 5 23 46
33 23

 

[Guest]

Shu, No wasted time and no worries...

I reconstructed your data and made a guess that the names are in column C
and the dates are in column F. The macro below will work if I guessed
correctly. If not, you can edit the Selection.Sort line and correct the
columns by changing the letter in the "=Range("C2")" and "=Range("F2")" parts
of the statement to the correct column letters.

Let me know if this does not work for you. I will recheck this post over
the next day or two.

Regards...

ChristopherTri


Sub ConditionalRowInsert()
'
' Macro written 1/6/2007 by ChristopherTri
'
Sheets("WiseG").Select
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("F2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
TestRow = 2
Do Until Cells(TestRow, 3) = ""
Match = Cells(TestRow, 3)
For i = 1 To 4 'Check for four repeats
If Cells(TestRow + i, 3) <> Match Then
Exit For
End If
Next i
If i < 5 Then 'Less than five repeats
TestRow = TestRow + i
For InsertRows = i + 1 To 5
Rows(TestRow).Select
Selection.Insert Shift:=xlDown
TestRow = TestRow + 1
Next InsertRows
Else 'Five or more repeats
TestRow = TestRow + i
Do While Cells(TestRow, 3) = Match
Rows(TestRow).Select
Selection.Delete
Loop
End If
Loop
End Sub

 

[Guest]

ChristopherTri, the Date is in F and the Name is in G and I cant seem to get
the data example to copy correctly. I get a compile error: Syntax error on
the first part of the code

Selection.Sort Key1:=Range("g2"), Order1:=xlAscending, Key2:=Range("f2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,

I created a macro using Ctrl M and just copied your macro over the code then
saved. ??? Right or Wrong?

 

[Guest]

Here is the exact copy of the macro, (e-mail address removed)

Sub Macro3()
'
' Macro3 Macro
' Macro recorded 01/06/2007 by ChristopherTri
'
' Keyboard Shortcut: Ctrl+m

Sheets("WiseG").Select
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("g2"), Order1:=xlAscending, Key2:=Range("F2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
TestRow = 2
Do Until Cells(TestRow, 3) = ""
Match = Cells(TestRow, 3)
For i = 1 To 4 'Check for four repeats
If Cells(TestRow + i, 3) <> Match Then
Exit For
End If
Next i
If i < 5 Then 'Less than five repeats
TestRow = TestRow + i
For InsertRows = i + 1 To 5
Rows(TestRow).Select
Selection.Insert Shift:=xlDown
TestRow = TestRow + 1
Next InsertRows
Else 'Five or more repeats
TestRow = TestRow + i
Do While Cells(TestRow, 3) = Match
Rows(TestRow).Select
Selection.Delete
Loop
End If
Loop
End Sub

 

[Guest]

Shu,

The lines between "Sheets("WiseG").Select" and "TextRow = 2" just sort the
data first using column G ascending, then usint column F descending. You can
delete the rows if you want to sort the sheet before you run the macro
(Data... Sort...).

To make sure that the code is in the right place, Open the visual basic
editor by clicking on Tools... Macro... Visual Basic Editor and make sure
that the code is copied into a module. You can see the modules in the folder
structure on the left side of the screen. Also, if the macro shows up in the
macro list it is in the right place.

ChristopherTri

 

[Guest]

ChristopherTri,

Works Fantastic!! Your skills are incredible. The only thing is it changes
the REC sorting which is numerical and if I resort, the blanks are removed or
placed at the bottom. The REC ( A ) must be maintained in order. The >
represent the blank rows you created and if you take them out of the example
that is what it looks like with a few columns at the end deleted for display
sake only. But as I said, the REC is not in the original order it was and
then when resorted to put them back the blanks disapear. NOTE, there may be
up to 16 names attributed to each RC number which usually only goes as high
as 10 but each row has a REC number to keep them in there original order.


A B C D E F G H I J
REC TR RC TK BE DATE NAME DIS CALL 2CALL
1 fst 1 TuP 39 4/11/2006 Chris D 5.50 0.00
2 fst 1 TuP 39 4/12/2006 Chris D 5.50 0.003 fst 2 TuP 39 4/11/2006 Dave D 5.50 0.00
4 fst 2 TuP 39 4/12/2006 Dave D 5.50 0.00
5 fst 2 TuP 39 4/13/2006 Dave D 5.50 0.006 fst 2 TuP 39 4/11/2006 Bill D 5.50 0.00
7 fst 2 TuP 39 4/12/2006 Bill D 5.50 0.00
8 fst 2 TuP 39 4/12/2006 Bill D 5.50 0.00
9 fst 2 TuP 39 4/13/2006 Bill D 5.50 0.00
10 fst 2 TuP 39 4/14/2006 Bill D 5.50 0.00
11 fst 2 TuP 39 4/11/2006 Sam D 5.50 0.00

 

[Guest]

Perfect, you're a wizard!

Shu,

The lines between "Sheets("WiseG").Select" and "TextRow = 2" just sort the
data first using column G ascending, then usint column F descending. You can
delete the rows if you want to sort the sheet before you run the macro
(Data... Sort...).

To make sure that the code is in the right place, Open the visual basic
editor by clicking on Tools... Macro... Visual Basic Editor and make sure
that the code is copied into a module. You can see the modules in the folder
structure on the left side of the screen. Also, if the macro shows up in the
macro list it is in the right place.

ChristopherTri