lookininward
lookininward

Reputation: 671

How to prevent row check being skipped when the previous row is checked and deleted?

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

Answers (4)

Blake
Blake

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

cyboashu
cyboashu

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

user3598756
user3598756

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

Vityata
Vityata

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

Related Questions