Variable criteria to delete rows

G

Guest

I need to delete entire rows if certain criteria exist. I used Ron de Bruin's macro (great macro Ron, thanks) and it worked fine. The problem is, I receive multiple downloads usually about 10,000 rows long each. I do not want to go in and change the code for each different download, as I would probably hose it up. I tried to enter the code in VB to have input boxes for what column to look in and what to look for, but I am not that versed in VB. Can someone get me started in the right direction? Below is the code from Ron de Bruin.

Sub Delete_row()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "A").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "A").Value = "ron" Then .Rows(Lrow).Delete
'This will delete each row with the Value "ron" in Column A, case sensitive.

End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
 
R

Ron de Bruin

Hi Jeff

This example will ask your for the criteria and it will
look in the Activecell column

Sub Delete_row_test()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim findstring As String

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

findstring = InputBox("Enter a Search value")
If Trim(findstring) <> "" Then

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, ActiveCell.Column).End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, ActiveCell.Column).Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, ActiveCell.Column).Value = findstring Then .Rows(Lrow).Delete

End If
Next
End With
End If
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


Jeff Bertram said:
I need to delete entire rows if certain criteria exist. I used Ron de Bruin's macro (great macro Ron, thanks) and it worked fine.
Click to expand...
The problem is, I receive multiple downloads usually about 10,000 rows long each. I do not want to go in and change the code for
each different download, as I would probably hose it up. I tried to enter the code in VB to have input boxes for what column to look
in and what to look for, but I am not that versed in VB. Can someone get me started in the right direction? Below is the code from
Ron de Bruin.
 
C

Cecilkumara Fernando

Ron,
What is the significant of having
.DisplayPageBreaks = False
in the code.
Regards,
Cecil

Ron de Bruin said:
Hi Jeff

This example will ask your for the criteria and it will
look in the Activecell column

Sub Delete_row_test()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim findstring As String

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

findstring = InputBox("Enter a Search value")
If Trim(findstring) <> "" Then

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, ActiveCell.Column).End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, ActiveCell.Column).Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, ActiveCell.Column).Value = findstring Then .Rows(Lrow).Delete

End If
Next
End With
End If
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
Click to expand...
Bruin's macro (great macro Ron, thanks) and it worked fine.
The problem is, I receive multiple downloads usually about 10,000 rows
Click to expand...
long each. I do not want to go in and change the code for
each different download, as I would probably hose it up. I tried to enter
Click to expand...
the code in VB to have input boxes for what column to look
in and what to look for, but I am not that versed in VB. Can someone get
Click to expand...
me started in the right direction? Below is the code from
 
R

Ron de Bruin

Hi Cecil

It will slow down the macro because it must change the
position of the pagebreaks after each row you delete.

That's why we set it to false
 
C

Cecilkumara Fernando

Enlightened!
Thank you,
Cecil

Ron de Bruin said:
Hi Cecil

It will slow down the macro because it must change the
position of the pagebreaks after each row you delete.

That's why we set it to false
Click to expand...
 
G

Guest

Ron: Can you help me modify this?? I have a similar issue to Jeff’s. I was
searching the forum for an answer and came upon this one. I’m trying to use
this to delete a row if the Column AD is equal to 0. How would I modify this
macro you have written? Thanks for your help!
 
G

Guest

Ron: It did not work! When I run the VB in break mode it starts deleting the
rows, but when I just run the Macro excel freezes up and stops responding.
Can you heklp me? Below is the code. My range is A11: AD1656 which can get
larger! The endrow portion works it works backward as you set it up and
deletes rows as it should. I was worried that I had a sum formula in column
AD was the issue, but that appears to not be the case. Any suggestions??
Thank you!

Sub delete_row_using_Column_AD()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, "AD").End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "AD").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "AD").Value = 0 Then .Rows(Lrow).Delete
'This will delete each row with the Value 0 in Column AD,
case sensitive.

End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
 
G

Guest

Ron,

Similar situation - Rather than deleting rows based on specific criteria, I
would like to keep rows based on certain criteria and copy them to a new
worksheet with the new worksheet name to be the date (e.g. 3-9-06). I would
like to keep and copy all rows whose value in Column D is either 1,2,3, or 4.
Any guidance in accomplishing this would be appreciated. Thanks.
 
G

Guest

Ron,

Not sure? In the rows I wish to delete, the value in Column D is either
blank or contains some text string (the text string varies).
 
R

Ron de Bruin

You can use advanced filter but then you must enter the four values into the worksheet
This example loop through the cells in D1:D1000 and copy to a new sheet

Sub Example2()
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = ActiveSheet
Set ws2 = Worksheets.Add

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With ws1
.DisplayPageBreaks = False
StartRow = 1
EndRow = 1000

For Lrow = StartRow To EndRow Step 1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "D").Value = "1" Or _
.Cells(Lrow, "D").Value = "2" Or _
.Cells(Lrow, "D").Value = "3" Or _
.Cells(Lrow, "D").Value = "4" Then .Rows(Lrow).Copy _
ws2.Cells(LastRow(ws2) + 1, 1)
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 
G

Guest

Brilliant!! Thanks Ron!

Ron de Bruin said:
You can use advanced filter but then you must enter the four values into the worksheet
This example loop through the cells in D1:D1000 and copy to a new sheet

Sub Example2()
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = ActiveSheet
Set ws2 = Worksheets.Add

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With ws1
.DisplayPageBreaks = False
StartRow = 1
EndRow = 1000

For Lrow = StartRow To EndRow Step 1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "D").Value = "1" Or _
.Cells(Lrow, "D").Value = "2" Or _
.Cells(Lrow, "D").Value = "3" Or _
.Cells(Lrow, "D").Value = "4" Then .Rows(Lrow).Copy _
ws2.Cells(LastRow(ws2) + 1, 1)
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Click to expand...
 
G

Guest

I have been fiddling around with formulas, templates, and now macros for
about the past month with my new job. Someone found out I was good with
computers and gave me a monstrous task to do. But anyways i have been
struggling with macros for a few days now to get it to do what i wanted. Ron
you are a god send, after an hour or 2 messing with your macro i finally
modified it to delete the rows in my list i no longer wanted. Thanks Again!!
 
J

jeremiah

I have just one thing that is stumping me. I have modified your code to go
accross multiple columns but there are certain columns that I get a Run Time
Error 13, Type Mismatch error on. I have column A through K, which are just
general numbers, about every other column has up to 2 decimal places. Those
columns with decimals are where I am getting the run time error. If I do not
incorporate those columns, then the macro runs perfectly.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

delete rows if cell in row contains "a" or "o" or empty 2
Run Code on Activate Sheet 6
Delete rows between two dates 12
Hiding rows with zero values 2
Newb: Asking about a tweak in code 2
Help With - Compile Error: Sub or Function Not Defined 2
With all sheets? 2
Delete rows based on comparison criteria 2

Top