Vba code - Automatically delete row based on keyword

[Neo45]

[FONT=&quot]HI,
[/FONT]
[FONT=&quot]Need to automatically delete row that contain certain keywords.
As an example -:
i have data sheet with 5 column.(Name,Last Name,Company Position,Email Address ,Phone Numbers )
If any of keywords are located in any cell (as part of a word, email, address, job title, company, etc,) need to delete the row automatically.
(keywords-loan,financial,bank,equity)

Thank you.[/FONT]

 

[Fennek]

Hi,

please understand that your problem is my entertainment.

In a little competition I developed the following approach, here it is ### untested ### for your question:

sub iFen()
KeyW = array("loan","financial","bank","equity")
With activeSheet
for each KW in KeyW
    .cells.replace KW, "=1/0"
next KW
.cells.specialcells(3,16).entirerow.delete    
end with
end sub

Maybe some debugging is necessary.

Feedback would be nice.

regards

 

[Neo45]

Hi Fennek

Thanks a lot response my question,can you do small changes in vba ,
according to the your vba,its delete word only .i need to delete full row.

As an example -:

Ima Financial Group (after the put vba it show like this, Ima =1/0 Group), i need to delete full row ,without remaining any word .

<tbody>
</tbody>

 

[Fennek]

Hi Neo,

the code first mark the cells with the keywords, then

.cells.specialcells(3,16).entirerow.delete

deletes the complete row with one error formula. Please test the code with F8 in the VBE (single step).

regards

 

[Fennek]

Hi,

please replace the function ".replace keyword, "=1/0"

with a "Range.Find" loop. Thie can search for parts in a cell and replace the whole cell.

regards

 

[Neo45]

Dear Fennek,

i couldn't understand code movement ,can you replace right VBA code,
actually its big help.

 

[Fennek]

Hi,

M$ explains the method "Range.Find" very good.

Again untested:

sub iFen()
KeyW = array("loan","financial","bank","equity")
With Activesheet.usedrange 
    for each KW in KeyW
            Set rng = .Find(KW, lookin:=xlValues, LookAt:=xlPart) 
            If Not rng Is Nothing Then 
                Do
                       firstAddress = rng.Address  
                       rng.formula = "=1/0"
                        Set rng = .FindNext(rng) 
                Loop While  rng.Address <> firstAddress 
            End If 
    next KW
End With
.cells.specialcells(3,16).entirerow.delete    
end with
end sub

I expect you to have a bit more than basic vba knowledge, especially the ability to debug.

regards

 

[Neo45]

Dear Fennek

After the run above code some error appear.

.Cells.SpecialCells(3, 16).EntireRow.Delete

highlight .Cells. word and error box invalid or unqualified reference.

 

[Fennek]

Hi,

the code is testet with 2 of the keyword in LO:

sub iFen()
Start = timer
KeyW = array("loan","financial","bank","equity")
With Activesheet.usedrange 
    for each KW in KeyW
            Set rng = .Find(KW, lookin:=xlValues, LookAt:=xlPart) 
            If Not rng Is Nothing Then 
                Do
                       firstAddress = rng.Address  
                       rng.formula = "=1/0"
                       on error resume next
                        Set rng = .FindNext(rng)
                        on error goto 0  
                Loop While  rng.Address <> firstAddress 
            End If 
    next KW
.cells.specialcells(xlFormulas,xlerrors).select
selection.entirerow.clear
End With
msgbox timer - Start
End Sub

Hope, it is better now. Please report the number of rows and the time.

regards

 

[Fennek]

Hi,

your question motivated me to do a few tests. Unfortunately it seems, that the concept of someone else is better.

The following codes creates a sample with 100,000 rows, the modified approach needed 5 seconds.

Sub prepare()
With Range("A1:A100000")
    .Formula = "=row()"
    .Value = .Value
    With .Offset(, 1)
        .Formula = "=if(int(rand()*10)=5,""abc loan qwe"", ""A"" & row())"
        .Value = .Value
    End With
End With
End Sub

' <<<<<<<<<<< start here for your data <start from="" here="" with="" your="" data="">>>>>>>>>>>

Sub iFen()
Start = Timer
Dim rng As Range
KeyW = Array("loan", "financial", "bank", "equity")
ls = Cells(1, Columns.Count).End(xlToLeft).Column + 1
Cells(1, ls) = 0
With ActiveSheet.UsedRange
    For Each KW In KeyW
            Set rng = .Find(KW, LookIn:=xlValues, LookAt:=xlPart)
            If Not rng Is Nothing Then
               firstAddress = rng.Address
                Do
                       Cells(rng.Row, ls) = 0
                        Set rng = .FindNext(rng)
                Loop While rng.Address <> firstAddress
            End If
    Next KW
    Debug.Print "nach find: ", Timer - Start
    With .Columns(ls)
         .SpecialCells(4).Formula = "=row()"
         .EntireRow.RemoveDuplicates .Column, xlNo
    End With
End With
Debug.Print "total: ", Timer - Start
End Sub

regards</start>