CODEWITHSUNDEEP
vbaexcelloopsconditional-statementsdelete-row
Todd Choi
Todd Choi

Reputation: 37

excel vba Delete rows until criteria

I am new to Excel VBA and could really use some help. I tried searching for a solution throughout the web but was unable to find a similar problem.

I am trying to create a macro that will help to delete Rows based on certain criteria and continue deleting rows until another certain criterion is met.

So for example. In the table below, I would like to delete Rows where Col A = 1 AND Col C = 0, and then continue deleting the rows below that row UNTIL Col A = 1 and Col C <> 0

  A  |  B  |  C
-----|-----|-----
 1   |  TC |  2 
-----|-----|-----
 2   |  TC |  1 
-----|-----|-----
 1   |  TC |  0 
-----|-----|-----
 2   |  TC |  2 
-----|-----|-----
 3   |  TC |  1 
-----|-----|-----
 1   |  TC |  2 
-----|-----|-----
 1   |  TC |  0
-----|-----|-----
 1   |  TC |  1
-----|-----|-----
 2   |  TC |  0
-----|-----|-----
 3   |  TC |  2

So the end result of the macro would be:

  A  |  B  |  C
-----|-----|-----
 1   |  TC |  2 
-----|-----|-----
 2   |  TC |  1 
-----|-----|-----
 1   |  TC |  2 
-----|-----|-----
 1   |  TC |  1
-----|-----|-----
 2   |  TC |  0
-----|-----|-----
 3   |  TC |  2

Ideally, I would like to Loop this again with Deleting Rows where Col A = 2 and Col C = 0 and deleting the rows below that row until Col A = 2 and Col C <> 0.

Below is the macro that I Came up with. Open to all suggestions and eager to learn. 

Sub deleterow()

Range("C2").Select
Do Until ActiveCell.Offset(0, -2) = "1" And ActiveCell.Value <> "0"
If ActiveCell.Value = "0" And ActiveCell.Offset(0, -2) = "1" Then
Rows(ActiveCell.Row & ":" & Rows.Count).Delete
End If
Loop

End Sub

Looking forward to hearing back!

Thank you

Upvotes: 1

Views: 1892

Answers (1)

danieltakeshi
danieltakeshi

Reputation: 939

Your loop stops on the first line, because the criteria is met. So the code below loops from first row to last filled row to search for the criterias.

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1) 'Set the first worksheet to work
Dim n As Long, i As Long
Dim rng As Range, new_rng As Range

lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'lastrow number
For n = 1 To 2 'Criteria is Col A = 1 To 2
    For i = 1 To lastrow 'Loop from 1 to last row
        If ws.Cells(i, 1) = n And ws.Cells(i, 3) = 0 Then
            If rng Is Nothing Then Set rng = ws.Range("A" & i) 'Set first Range so Union won't give an error
            Set new_rng = ws.Range("A" & i)
            Set rng = Union(rng, new_rng) 'create a non contiguous range to delete
        End If
    Next i
Next n

rng.EntireRow.Delete

Note that if the Sheet is large, it isn't the optimal method. There are best ways to improve the code performance. A loop was used, because it was the method tried by the OP.

Another way is to filter for multicriteria and delete the shown rows.

Upvotes: 0

Related Questions