PDA

View Full Version : Need help deleting rows based on cell criteria



codys21
06-12-2015, 09:57 AM
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!

SamT
06-13-2015, 05:33 AM
Always declare Row and Column Variables as Long

Don't use

Range(X).Select
It is not needed and makes UsedRange.Rows.Count = Sheet.Rows.Count

In the first sub, you are using Column D to find the last row.

Try this Last Row function

LastRow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

At this time, I see no other possibilities than those that might cause the problem.


Option Explicit

Sub SamT_1()
'Assumptions:
' Column B is the longest filled column
' IF Column B or D has an empty cell, delete that row

Dim Firstrow As Long
Dim Lastrow As Long
Dim lrow As Long

With ActiveSheet
'Find first and last used row in column B
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .Cells(Rows.Count, 2).End(xlUp).Row


'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
If .Cells(lrow, 2).Value < 15 Or .Cells(lrow, 4).Value < 0.05 Then _
.Rows(lrow).EntireRow.Delete
Next lrow
End With
End Sub

snb
06-13-2015, 07:32 AM
Sub M_snb()
With Sheet1.Cells(1).CurrentRegion.Columns(2)
.AutoFilter 1, "<15"
.Offset(1).EntireRow.Delete
.AutoFilter
End With
End Sub

Paul_Hossler
06-13-2015, 09:11 AM
I like snb's technique - faster than the looping approach I was thinking about




Option Explicit

Sub M_snb_ph()

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

Application.ScreenUpdating = False

With ActiveSheet.Cells(1).CurrentRegion

With .Columns(2)
.AutoFilter 1, "<15"
.Offset(1).EntireRow.Delete
End With
.AutoFilter

With .Columns(4)
.AutoFilter 1, "<.05"
.Offset(1).EntireRow.Delete
End With

.AutoFilter

End With
Application.ScreenUpdating = True
End Sub