Macro to delete all rows except .

Sunline · Jul 30, 2011

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 · Jul 31, 2011

Please try also:

Code:

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

Peter_SSs · Jul 31, 2011

Sunline said:
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.

 Sub Del_Rows() Dim LR As Long, LC As Long, i As Long, rws As Long Dim aCol, tmp Const LookForVal As String = "Mdn" '<- Value you are looking for LR = Range("O" & Rows.Count).End(xlUp).Row LC = Cells(1, Columns.Count).End(xlToLeft).Column aCol = Range("O2:O" & LR).Value ReDim tmp(1 To LR - 1, 1 To 1) For i = 1 To LR - 1 If InStr(1, aCol(i, 1), LookForVal, 1) = 0 Then rws = rws + 1 tmp(i, 1) = 1 End If Next i If rws > 0 Then Application.ScreenUpdating = False Columns("A").Insert With Range("A2").Resize(LR - 1) .Value = tmp .Resize(, LC + 1).Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo .Resize(rws).EntireRow.Delete End With Columns("A").Delete Application.ScreenUpdating = True End If MsgBox "Done" '<-- Delete this line? End Sub

mirabeau · Jul 31, 2011

Hi Sunline,

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

Code:

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 · Jul 31, 2011

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 · Jul 31, 2011

Peter_SSs said:
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:

Code:

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

Code:

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 · Jul 31, 2011

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 · Jul 31, 2011

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

Sunline said:
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 · Jul 31, 2011

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 · Aug 1, 2011

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 · Aug 1, 2011

Sunline said:
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

rtu

o

x

g

fghfg

3

s

k

l

yui

yu

op

x

o

i

iup

o['

h

aaMdn

4

g dthg

uk

gf

jh

k

l;

l

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

Mdn

7

tyj

iuol

po'

u

9=

yt

x

fghfg

8

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?

Macro to delete all rows except .

Sunline

Well-known Member

wigi

Well-known Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

mirabeau

Banned user

Peter_SSs

MrExcel MVP, Moderator

mirabeau

Banned user

Sunline

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

mirabeau

Banned user

Sunline

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Macro to delete all rows except .

Well-known Member

Well-known Member

Excel Facts

MrExcel MVP, Moderator

Banned user

MrExcel MVP, Moderator

Banned user

Well-known Member

MrExcel MVP, Moderator

Banned user

Well-known Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock