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 .

 

[wigi]

Please try also:

Sub removingrows()
    With [A1].CurrentRegion.Columns(15)
        .AutoFilter 1, "<>Mdn"
        .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
    End With
End Sub

 

[Peter_SSs]

delete all rows using col O except when Mdn is mentioned .

Did you mean column O = "Mdn" or column O contains "Mdn" somewhere?

My code keeps the row if "Mdn" is contained somewhere in the cell and is not case sensitive. If I haven't got that part quite right post back with details. I think you'll find the speed improved.
I've also assumed that row 1 can be used to determine the last column of data.

<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>    <SPAN style="color:#00007F">Const</SPAN> LookForVal <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "Mdn" <SPAN style="color:#007F00">'<- Value you are looking for</SPAN><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">If</SPAN> InStr(1, aCol(i, 1), LookForVal, 1) = 0 <SPAN style="color:#00007F">Then</SPAN><br>            rws = rws + 1<br>            tmp(i, 1) = 1<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</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>        Columns("A").Insert<br>        <SPAN style="color:#00007F">With</SPAN> Range("A2").Resize(LR - 1)<br>            .Value = tmp<br>            .Resize(, LC + 1).Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo<br>            .Resize(rws).EntireRow.Delete<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Columns("A").Delete<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" <SPAN style="color:#007F00">'<-- Delete this line?</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[mirabeau]

Hi Sunline,

With that much data, you may find this one useful.

Sub deletrow()
Dim lr&, lc&, u()
Dim rgo, i&, k&
lr = Cells.Find("*", after:=Cells(1), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
lc = Cells.Find("*", after:=Cells(1), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
ReDim u(1 To lr, 1 To 1)
rgo = Range("O1").Resize(lr)
For i = 2 To lr
    If InStr(rgo(i, 1), "Mdn") > 0 Then u(i, 1) = 1: k = k + 1
Next i
Cells(1, lc + 1).Resize(lr) = u
Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1, Header:=xlYes
Range("A" & k + 2, Cells(lr, lc)).ClearContents
Cells(1, lc + 1).Resize(lr).ClearContents
MsgBox "Done"
End Sub

 

[Peter_SSs]

mirabeau

You most likely recognise the code in my post as a very slightly modified version of code you have posted previously (that I was clearly impressed by since I have reproduced it a few times since ).

Your code here is a little faster again. Would that basically be put down to not having to insert/delete column A? Perhaps also ClearContents as opposed to deleting rows?

 

[mirabeau]

mirabeau

You most likely recognise the code in my post as a very slightly modified version of code you have posted previously (that I was clearly impressed by since I have reproduced it a few times since ).

Your code here is a little faster again. Would that basically be put down to not having to insert/delete column A? Perhaps also ClearContents as opposed to deleting rows?

Hi Peter,

I appreciate the acknowledgment, although I wasn't really aware that you had based any of your codes on anything I'd done.

My above post actually was compiled and posted without knowing you had already posted a sort-based code. Had I known that I probably would have avoided the sort approach and posted one of a couple of other possibilities (given below).

But I seem to be reaching a limit of about 2 seconds to do 170,000 rows with about 50% Mdn's in Column("O"), by whatever approach. All of those codes seem to take about 2 secs.

Non-sorting codes:

Sub deletrow2()  'based on juggling arrays
t = Timer
Dim lr&, lc&, a, c()
Dim i&, j&, k&
lr = Cells.Find("*", after:=Cells(1), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
lc = Cells.Find("*", after:=Cells(1), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
a = Range("A1").Resize(lr, lc)
ReDim c(1 To lr, 1 To lc)
For i = 2 To lr
    If InStr(a(i, 15), "Mdn") > 0 Then
        k = k + 1
        For j = 1 To lc
            c(k, j) = a(i, j)
        Next j
    End If
Next i
Range("A2").Resize(lr - 1, lc).ClearContents
Range("A2").Resize(k, lc) = c
MsgBox Format(Timer - t, "0.000")
End Sub

Sub delrow() 'for Excel 2007 et seq, based on Remove Duplicates
t = Timer
Dim lr&, lc&, u()
Dim rgo, i&, k&
lr = Cells.Find("*", after:=Cells(1), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
lc = Cells.Find("*", after:=Cells(1), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
ReDim u(1 To lr, 1 To 1)
rgo = Range("O1").Resize(lr)
For i = 2 To lr
    If InStr(rgo(i, 1), "Mdn") > 0 Then u(i, 1) = i
Next i
Cells(1, lc + 1).Resize(lr) = u
Range("A1").Resize(lr, lc + 1).RemoveDuplicates Columns:=lc + 1, Header:=xlYes
Cells(2, lc + 1).Resize(lr - 1).SpecialCells(4).EntireRow.Delete 'to remove the sole remaining blank
Cells(1, lc + 1).Resize(lr).ClearContents
MsgBox Format(Timer - t, "0.000")
End Sub

I think your conjecture about inserting/deleting Column("A") is probably correct, since it may involve moving quite a number of columns. With very large datasets, I like to make the worksheet do as little work as possible, since small inefficiencies tend to cumulate.

For a give-sized contiguous range however, I don't see much difference in speed between deleting/clearing contents, so long as other rows/columns are not also required to be moved.

But I think you know more about this than I do ...

 

[Sunline]

Hi , thanks again to all for replies .

Yes Peter col O only contains "mdn" somewhere . im not sure what case sensitive is in sorry . I will google that one .

Mirabeau you have supplied me with some macros in the past which have proven invaluable .

Col O is totally populated as well , no blanks at all . Row 1 always headings , no delete .
Just at work so will try out tonight , will advise . Thanks .

 

[Peter_SSs]

My code keeps the row if "Mdn" is contained somewhere in the cell and is not case sensitive.

im not sure what case sensitive is in sorry .

This just means that my code will keep the row if column O contains mdn whether it is upper case, lower case or a mixture, so all thes (and more) would be kept.
Mdn
MDN
mdn
mDn
etc

 

[mirabeau]

Sunline,

Thanks for your comment.
This post is just for clarification.

Case sensitive: "Mdn" is treated as a different string from "mdn" or "mDn" etc. If case insensitive they are treated as the same.
Those codes are very easily modified so they'll work either way.
But you can't have them both at once, and code-writer relies on thread-opener to specify which is wanted.

Appear "somewhere": Depends on whether your criterion for deletion is that some cells in ColO should contain "Mdn" and nothing else.
Or whether a cell entry like "23Mdnxyz" also requires a row deletion. Peter's and my codes apply to both of these cases, but are very easily modified if you only want one to apply.

You'll need to make your own assessment of the other suggested codes/approaches in this thread.

 

[Sunline]

Right , here we go .
Apoligies too Peter col O = MDN , (as data is on my sheet) , i didnt realise mDn , MdN etc were all different .
Still not having any joy getting these to work .
Should mention using version 2007 , dual core processor , 2.8 ghz , 2 geg ram memory , 2 yr old comp and not piled up with junk , over 90% disk space . I keep it this way so excel can run at max . Currently running a few other hungry macros which work good .

Peter yours ran for 15 mins so i thought this also may not be working , i then went ctrl-alt-delete , will let it run when im sleeping as it may take awhile .

Mirabeau tried your first suggestion and that deleted everything except heading row 1 .
Then tried delrow macro and that deleted everything except heading row and one row but did contain MDN within the cell amongst other text .
Then tried deleterow2 and got run time error 7 , out of memory .

Not sure what im doing wrong (again) , may have to go back to old custom sort .

Thanks for all imput .

 

[Peter_SSs]

Peter yours ran for 15 mins so i thought this also may not be working , i then went ctrl-alt-delete , will let it run when im sleeping as it may take awhile .

Something definitely appears to be going wrong. We obviously do not have your actual data but I agree with mirabeau that our macros have been completing in well under 3 seconds. I have actually been testing with about 200,000 rows and data in columns A:O, with "Mdn" appearing somewhere in about 60,000 of those rows.

Here's a small sample of my data. Any chance you could provide a similar number of rows of yours so we can see just what we are dealing with?

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	H1	H2	H3	H4	H5	H6	H7	H8	H9	H10	H11	H12	H13	H14	H15
2	fg	yu	ui	i	ytu	fsdf	fsd	x	x	x	rtu	o	x	g	fghfg
3	s	k	l		yui	yu	op	x	x	o	i	iup	o['	h	aaMdn
4	g dthg	uk	gf	jh	k	l;	l	x	x	d	i	dfsd	p]	bh	yrtyu
5	h	ui	hg	k	hl	jk	as	hg	c	z	d	hj	x	f
6	trh	l	jg	h	[]	ad	gfd	j	fxdg	d	s	gh	x	x	Mdn
7	tyj	iuol	po'	u	9=	yt	x	x	x	x	x	x	x	x	fghfg
8	x	x	x	x	x	x	x	x	x	x	x	x	x	x	aaMdn
Del Rows

Why don't you also try creating a new workbook and just copy this data in and make sure the code works (almost instantly) on that?

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?