Macro to delete all rows except .

[Sunline]

Hello all , i was wanting to get a basic macro that can delete all rows using col O except when Mdn is mentioned .
Also leave row 1 as heading , dont delete row 1 .
Thanks .

 

[Peter_SSs]

BTW, does your sheet have any formulas down those 170,000 rows and do you have any other code (eg Worksheet_Change code) in operation with the sheet?

In case the answer to either of these is 'Yes', you could try replacing the relevant section of my code with this.

If rws > 0 Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    With Range("A2").Resize(lr - 1)
        .Offset(, lc).Value = tmp
        .Resize(, lc + 1).Sort Key1:=.Cells(1, lc + 1), _
            Order1:=xlAscending, Header:=xlNo
        .Resize(rws).EntireRow.Delete
        .Offset(, lc).ClearContents
    End With
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End If

 

[Sunline]

Hello Peter , sample sheet provided , im about to test macros against your latest test sheet .
Its a huge task to copy too another sheet as i have only mastered exporting values only in last couple of weeks . I do have macros which can run right thru the 171,000 rows , some can take up to 27 mins but thats ok .
The sheet does contain formulars but nothing to do with Col O . These functions are for a points system im developing for my own personal use .
Thanks .

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	ID	PQ	Yea	Mon	Meet	Date	Day	Win	Place	Con	Con#	Weather	Rail	Time	Class	Dist	Stakes	R#	Fsz		Race Name	Placing
2	225	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			1
3	226	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			2
4	227	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			3
5	228	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			4
6	229	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			5
7	230	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			6
8	231	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			7
9	232	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			8
10	233	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:00:00 p.m.	MDN	2100	$30,000.00	2	9			9
11	242	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			1
12	243	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			2
13	244	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			3
14	245	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			4
15	246	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			5
16	247	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			6
17	248	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			7
18	249	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			8
19	250	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			9
20	251	PQ	2006	Mar	Tren	18/03/2006	Saturday	$0.00	$0.00	Good		Fine	True Position	1:35:00 p.m.	3YO HCP	1200	$20,000.00	3	10			10
Sheet1

 

[Peter_SSs]

The sheet does contain formulars but nothing to do with Col O .

However, the formulas will recalculate during my code and that is likely to be slow with so many rows. Try replacing the section of code as described in post #21.

If that doesn't help significantly, tell us what any row 2 formulas are and what columns they are in.

 

[Sunline]

Peter i just got your original macro with your lastest amendment added to work .
It took just under 4 mins which is OK for me .

If i may ask one last request , as i didnt explain correctly from the start , this works great and i would of needed it to delete all but keep when word is mentioned anywhere in cell as there other classes simalar , which this macro does .
Can i get it to delete all except row 1 heading of course when cell equals MDN only . Not Mdn 3YO or Mdn C&G , keep Mdn , MDN , mDN , etc only .

I will keep working on this to get it down to the approx 3 second mark .
Thanks .

 

[Peter_SSs]

Can i get it to delete all except row 1 heading of course when cell equals MDN only . Not Mdn 3YO or Mdn C&G , keep Mdn , MDN , mDN , etc only .

Try this. Change this line - note the UPPER CASE

Const LookForVal As String = "MDN"

and replace the first line below with the second one.

If InStr(1, aCol(i, 1), LookForVal, 1) = 0 Then
If UCase(aCol(i, 1)) <> LookForVal Then

Also, do you need the formulas to remain as formulas in the sheet or could they be replaced with their results?

 

[Sunline]

I made the changes you suggested in your last post and macro ran for 15 mins , when i stopped it it said ,
run time error - 2147417848(80010108) method sort of object range failed .

I would prefer to keep the formulars in the sheet , but i do take on board i may need too i think is it copy all as values .
So i will have to come to the best arrangement i can with the macro that works . Might have to do some sorting and deleting with smaller delete macros using <than , >than , between .
Thanks .

 

[Peter_SSs]

I can't make the code take anything like that long so I suspect that your formulas may be the problem in terms of time.

Just to test, take a copy of your workbook, Copy and Paste Special Values all the formulas and run the code on it.

 

[Sunline]

Ok thanks for that i will make a copy and test . Will report back on this . Just at work and also realised i failed to tell you what functions are in my sheet , will advise .

Peter if i wanted to delete all except MDN , Rating 90 , 3YO F , 0-4Wins , how do i write this too include my last 3 suggestions along as MDN as well .

Just giving myself some more options with this .
Thanks .

 

[Peter_SSs]

Peter if i wanted to delete all except MDN , Rating 90 , 3YO F , 0-4Wins , how do i write this too include my last 3 suggestions along as MDN as well .

Assuming they are all in column O I would change the code structure a little.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Del_Rows()<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> aCol, tmp<br>                     <br>    lr = Range("O" & Rows.Count).End(xlUp).Row<br>    lc = Cells(1, Columns.Count).End(xlToLeft).Column<br>    aCol = Range("O2:O" & lr).Value<br>    <SPAN style="color:#00007F">ReDim</SPAN> tmp(1 <SPAN style="color:#00007F">To</SPAN> lr - 1, 1 <SPAN style="color:#00007F">To</SPAN> 1)<br>    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> lr - 1<br>        <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> UCase(aCol(i, 1))<br>            <SPAN style="color:#00007F">Case</SPAN> "MDN", "RATING 90", "3YO F", "0-4WINS"<br>               <br>            Case <SPAN style="color:#00007F">Else</SPAN><br>                rws = rws + 1<br>                tmp(i, 1) = 1<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    <SPAN style="color:#00007F">If</SPAN> rws > 0 <SPAN style="color:#00007F">Then</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        Application.Calculation = xlCalculationManual<br>        Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">With</SPAN> Range("A2").Resize(lr - 1)<br>            .Offset(, lc).Value = tmp<br>            .Resize(, lc + 1).Sort Key1:=.Cells(1, lc + 1), _<br>                Order1:=xlAscending, Header:=xlNo<br>            .Resize(rws).EntireRow.Delete<br>            .Offset(, lc).ClearContents<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>        Application.Calculation = xlCalculationAutomatic<br>        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    MsgBox "Done"<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Sunline]

Thanks for this Peter will try out over the weekend .
Thanks too all for your posts .