VBA code to delete line

Question

Guys, I have a code that checks the line if there’s a word or phrase and deletes the line:

If Mid(Cells(i, 10), 1, 50) <> "Defeito" Then Rows(i).Delete Shift:=xlUp

However I in the spreadsheet there are phrases like "Defect + broadband" or "Defect tv", I would like the code whenever I check that there is any word in the sentence other than "Defect", for example, "modem installation" or "meal", it delete the line but leave the lines containing the word "Defect" inside the phrase.

Answer 1

I can think of three ways to accomplish this action:

• Excel functions for string manipulation InStr() and Len()
• Wildcards
• Regex

And different ways, some more optimized to delete

Excel functions

A normal loop on each line where two factors are checked in the string.

Urge

First if it contains the word "Defect" with the function Urge() and the code InStr(1, ws.Cells(i, 10), "Defeito", 1), returns 0 if there is no word and there is no 0.

Len

Then the function Len(), that checks the length of the string, as the default word alone has 7 characters. Then it is checked whether the length is greater than 7 characters.

Loop to erase

Finally, if there is the word Default and if the String is larger than 7 characters, a loop is performed backwards to delete each line. This is a slow process, which for more than 10,000 lines would take some time.

Dim UltimaLinha As Long, i As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
For i = UltimaLinha To 2 Step -1
    If InStr(1, ws.Cells(i, 10), "Defeito", 1) <> 0 And Len(ws.Cells(i, 10)) > 7 Then Rows(i).Delete Shift:=xlUp
Next i

Wildcard

Two ways to delete with Wildcard:

• Match
• Autofilter

Match

The Function of Excel Match() is used together with Wildcard and deleted by loop.

Dim UltimaLinha As Long, i As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
For i = UltimaLinha To 2 Step -1
     If Not IsError(Application.Match("Defeito " & "*", ws.Range("J" & i), 0)) Then Rows(i).Delete Shift:=xlUp
Next i

Autofilter

Dim UltimaLinha As Long, i As Long
Dim ws As Worksheet
Dim RangeFiltrar As Range, RangeVisivel As Range
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
With ws
    'Mostra os dados filtrados
    If .FilterMode Then
        .ShowAllData
    End If
    Set RangeFiltrar = .Range(.Cells(1, 10), .Cells(UltimaLinha, "J"))
    RangeFiltrar.AutoFilter Field:=1, Criteria1:="Defeito " & "*", Operator:=xlFilterValues
End With

On Error Resume Next
Set RangeVisivel = ws.Range(ws.Cells(2, 10), ws.Cells(UltimaLinha, "J")).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not RangeVisivel Is Nothing Then
    RangeVisivel.EntireRow.Delete
End If

If ws.FilterMode Then
    ws.ShowAllData
End If

Autofilter is used with wildcard and then the visible lines are deleted, this method is faster than a loop line by line.

Regex

Regular Expressions can be used, where a demo in Regex101 can be viewed and the expression: Defeito.+

Enable Regex in Excel

1. Regex needs to be enabled, Enable the Developer mode
2. In the 'Developer' tab, click 'Visual Basic' and the VBA window will open.
3. Go to 'Tools' -> 'References...' and a window will open.
4. Search for 'Microsoft Vbscript Regular Expressions 5.5', as in the image below. And enable this option.

Code

In this code the cell is validated by Regex and then a non-contiguous Range is created and at the end the entire range is deleted.

This method is faster by performing the delete action at once, than performing the loop one by one.

Dim UltimaLinha As Long, j As Long
Dim ws As Worksheet
Dim Dados()
Dim strData As String
Dim rng As Range, nova_rng As Range
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
'Preenche dados na Matriz Dados

With ws
    Dados = .Range("J1:J" & UltimaLinha).Value2
    Dim objMatches As Object, objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    'Regex
    objRegExp.Pattern = "Defeito.+"
    objRegExp.Global = True
    'Executa Regex
    For j = LBound(Dados) To UBound(Dados)
        strData = Dados(j, 1)
        Set objMatches = objRegExp.Execute(strData)
        If objMatches.Count <> 0 Then
            For Each m In objMatches
                'Realiza ação para cada combinação encontrada
                'Debug.Print strData
                If rng Is Nothing Then Set rng = .Range("J" & j) 'Define o primeiro item da range para não ocorrer erro na função Union
                Set nova_rng = .Range("J" & j)
                Set rng = Union(rng, nova_rng) 'Cria a range não contígua para deletar
            Next m
        End If
    Next j
End With
rng.EntireRow.Delete

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.