Need help deleting rows based on cell criteria

codys21

New Member
Joined
Jun 12, 2015
Messages
19
Hi all,

So I have four columns of data and I am trying to delete entire rows based on a cell's value in a particular column. I need to do this for two columns (column B and column D in my data). The first column (B) I do it for works just fine and takes my data from 25397 rows down to 11715 rows. The second column (D) I do it for should bring it down from that 11715 to 1510 (these values will change every month which is why I am trying to use VBA.) Anyway, I pretty much copied and pasted from code from column B to column D, with only changing the name of the sub, the column it is looking at, and the values it will delete, but when I run it on column D, excel keeps loading and loading and eventually stops responding. Any ideas on why this is happening and how to fix it? I have attached the code I am using. I am not too experienced with VBA so I am using a modified version of some code I found online. The first sub deletes rows with values under 15 in column B, the second sub is suppose to delete rows with values under 0.05 in column D (I want to delete values with less than 5% in column D.)

Sub DeleteValuesUnder15()


Dim workrange As Range
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim lrow As Integer


'Find first and last used row in column B
Range("B:B").Select
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.Range("D1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row


'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
Set workrange = Cells(lrow, 2)
If workrange.Value < 15 _
Then workrange.EntireRow.Delete


Next lrow


End Sub



Sub DeletePercentUnder5()


Dim workrange As Range
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim lrow As Integer


'Find first and last used row in column D
Range("D:D").Select
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.Range("D1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row


'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
Set workrange = Cells(lrow, 3)
If workrange.Value < 0.05 _
Then workrange.EntireRow.Delete


Next lrow


End Sub


Thank you for any help!
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Try:
Code:
Sub DelRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$" & LastRow).AutoFilter Field:=2, Criteria1:="<15", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$D$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$" & LastRow).AutoFilter Field:=4, Criteria1:="<.05", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$D$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Hi all,

the second sub is suppose to delete rows with values under 0.05 in column D (I want to delete values with less than 5% in column D.)



Sub DeletePercentUnder5()


Dim workrange As Range
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim lrow As Integer


'Find first and last used row in column D
Range("D:D").Select
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.Range("D1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row


'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
Set workrange = Cells(lrow, 3)
If workrange.Value < 0.05 _
Then workrange.EntireRow.Delete


Next lrow


End Sub


Thank you for any help!

The bold red part above is referring to column C not column D. Change it to:

Cells(lrow,4)

or you could use:

Cells(lrow,"D")
as a better reminder that it's col D you want to scan for values less than 5%.
 
Upvote 0
Try:
Code:
Sub DelRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$" & LastRow).AutoFilter Field:=2, Criteria1:="<15", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$D$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$" & LastRow).AutoFilter Field:=4, Criteria1:="<.05", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$D$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
    Application.ScreenUpdating = True
End Sub

Perfect, thanks! The autofilter did it. Much better than going row by row.
 
Upvote 0
My apologies. The macro in my previous post won't work properly. In order for the following macro to work, your data must start in row 2 with columns headers in row 1.
Code:
Sub DelRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ActiveSheet.Range("$A$1:$D$" & LastRow).AutoFilter Field:=2, Criteria1:="<15", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$2:$D$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    ActiveSheet.Range("$A$1:$D$" & LastRow).AutoFilter Field:=4, Criteria1:="<.05", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$D$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top