Use VBA to delete rows with criteria determined by a cell

Question

Use VBA to delete rows with criteria determined by a cell

Navigation

#1 by (0 votes)

0

I need a Vba to do the following action: As soon as it is activated, read a specific cell and erase lines from another flap taking into account the specific cell as a criterion. Example:
In Sheet1 I have two products:
Blue Shirt A
Blue Shirt B
But in worksheet 2 in cell D2 it is written only "Blue". I need this code to consider the text present in cell D2 of Sheet2 and erase the lines where both shirts are present in Sheet1, considering only the word "Blue" in the texts inside the cells.

I use the code below normally

lLast = Planilha1.UsedRange.Rows.Count

For lRow = lLast To 2 Step -1
If _
Cells(lRow, "A") Like "*Critério*" Then
Rows(lRow).Delete
    End If
Next lRow'

But in this case I could not reference the cell, if I have how to use it like I would?

excel vba excel-vba planilhas

asked by anonymous 19.10.2018 / 21:36

1 answer

2012 Model of a Java Mobile Inference dependency injection in Typescript - Angular 6

score 0 · Answer 1

Example

Assuming two worksheets, one called "Worksheet 1" and another "Worksheet2".

The data is inserted in "Sheet1", according to the following table:

|   |       A        |
|---|----------------|
| 1 |                |
| 2 | Camisa Azul A  |
| 3 | Camisa Verde A |
| 4 | Camisa Azul B  |
| 5 | Camisa Verde B |

And in the "D2" cell of "Sheet2" the word Blue

Code

Dim UltimaLinha As Long, i As Long
Dim ref As String
Dim Rng As Range, nova_rng As Range
Dim ws_ref As Worksheet, ws_dest As Worksheet
Set ws_ref = ThisWorkbook.Worksheets("Planilha2")
Set ws_dest = ThisWorkbook.Worksheets("Planilha1")
'Referência
ref = ws_ref.Range("D2")

With ws_dest
    UltimaLinha = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = UltimaLinha To 2 Step -1
        If Not IsError(Application.Match("*" & ref & "*", .Range("A" & i), 0)) Then
            If Rng Is Nothing Then Set Rng = .Range("A" & i) 'Define o primeiro item da range para não ocorrer erro na função Union
            Set nova_rng = .Range("A" & i)
            Set Rng = Union(Rng, nova_rng)   'Cria a range não contígua para deletar
        End If
    Next i
End With
Rng.EntireRow.Delete

Explanation

Assigns to the reference worksheet ws_ref , where the cells are filled with the reference criteria.
Assigns the target worksheet ws_dest with the value of the Reference Worksheet.
Assigns the value of D2 to the variable ref
Find the Last row of column A of the spreadsheet ws_dest
Loops the Last Line to the second, looking for a Match of the value of ref
Creates a non-contiguous Union with the cells of the found values. The union is created because it is faster to delete everything at once than to delete row by row.
Delete the entire line of the desired range with Rng.EntireRow.Delete or if you just want to clear the entire line Rng.EntireRow.Clear

Note: For more information on other ways to do this, see this answer >

Result

|   |       A        |
|---|----------------|
| 1 |                |
| 2 | Camisa Verde A |
| 3 | Camisa Verde B |

Note:

Deleting / Deleting data is very sensitive and complicated, as they can be lost forever. I suggest backing up the old data and creating a copy of the spreadsheet / data for testing.