Reputation: 671
This is intended to loop through two columns and verify that the value in the L column is lower than a specific (single) value in a cell from another sheet. It also checks to see if there is an "#N/A" error in the cell on the same row in column M. If these are true then the entire row is deleted. The code below appears to work, however, I have to run the For loop multiple time to get fully delete all the rows. My hunch is that when a row is deleted it's not checking the one right below it and moving on. How can I avoid this? Any help is appreciated.
Sub removerows()
Dim wsOut As Worksheet
Dim wsPrev As Worksheet
Dim r As Long
Dim Lastrow As Long
Set wsOut = Worksheets("Output")
Set wsPrev = Worksheets("Previous")
Lastrow = wsOut.UsedRange(wsOut.UsedRange.Cells.Count).Row
For r = 2 To Lastrow
If wsOut.Cells(r, "L").Value < wsPrev.Cells(2, "L").Value And _
Application.WorksheetFunction.IsNA(wsOut.Cells(r, "M").Value) Then
wsOut.Cells(r, "L").EntireRow.Delete
Else
wsOut.Cells(r, "L").Interior.ColorIndex = 20
End If
Next
End Sub
Upvotes: 1
Views: 193
Reputation: 230
Just add r = r - 1 after the row is deleted.
Sub removerows()
Dim wsOut As Worksheet
Dim wsPrev As Worksheet
Dim r As Long
Dim Lastrow As Long
Set wsOut = Worksheets("Output")
Set wsPrev = Worksheets("Previous")
Lastrow = wsOut.UsedRange(wsOut.UsedRange.Cells.Count).Row
For r = 2 To Lastrow
If wsOut.Cells(r, "L").Value < wsPrev.Cells(2, "L").Value And _
Application.WorksheetFunction.IsNA(wsOut.Cells(r, "M").Value) Then
wsOut.Cells(r, "L").EntireRow.Delete
***** r = r -1 'Done! it will recheck the same cell after
Else
wsOut.Cells(r, "L").Interior.ColorIndex = 20
End If
Next
End Sub
Upvotes: 0
Reputation: 10443
Run a reverse loop.
Change For r = 2 To Lastrow
to For r = Lastrow to 2 Step -1
.
Didn't test it as I am on mobile but this should resolve your issue.
Upvotes: 2
Reputation: 29421
you could speed it up and avoid loops by use of AutoFilter()
:
Option Explicit
Sub removerows()
Dim prevValue As Double
prevValue = Worksheets("Previous").Range("L2")
With Worksheets("Output") '<--| reference your "output" sheet
With .Range("M1", .Cells(.Rows.count, "L").End(xlUp)) '<--| reference its columns "L:M" range from row 1 (header) down to column "L" last not empty row
.AutoFilter Field:=1, Criteria1:="<" & prevValue '<--| 1st filter on column "L" with values lower than sheet "previous" sheet "L2" cell
.AutoFilter Field:=2, Criteria1:="#N/A" '<--| '<--| 2nd filter on column "M" with values "#N/A" values
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--| if any filtered cells then delete their row
.AutoFilter '<--| remve filters
.AutoFilter Field:=1, Criteria1:=">=" & prevValue '<--| filter on column "L" with values greater or equal than sheet "previous" sheet "L2" cell
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 20 '<--| if any filtered celld then color them
End With
End With
End Sub
Upvotes: 0
Reputation: 43595
Sub removerows()
Dim wsOut As Worksheet
Dim wsPrev As Worksheet
Dim r As Long
Dim Lastrow As Long
Set wsOut = Worksheets("Output")
Set wsPrev = Worksheets("Previous")
Lastrow = wsOut.UsedRange(wsOut.UsedRange.Cells.Count).Row
For r = Lastrow To 2 step -1
If wsOut.Cells(r, "L").Value < wsPrev.Cells(2, "L").Value And _
Application.WorksheetFunction.IsNA(wsOut.Cells(r, "M").Value) Then
wsOut.Cells(r, "L").EntireRow.Delete
Else
wsOut.Cells(r, "L").Interior.ColorIndex = 20
End If
Next
End Sub
The idea is to make the loop backwards, if you are deleting.
Upvotes: 1