VBA - Remove rows from XLSX where particular text can be found within a cell

novadon

New Member
Joined
Nov 15, 2018
Messages
3
I'm super new to VBA and hoping I could get some help please ... I'm looking for a succinct way to remove rows from a sheet via Macro and the VBA samples I've tried I cant get to work. I'm hoping it's something simple :)
The macro would remove a row that DOES NOT contain a specific values (from a specific column) from within an array. I sort of had it working, and full disclosure, I've borrowed code from other examples. The latest sample I'm working with just deletes everything, the other sample I was working with deleted Acro32.exe, but kept everything else. So not yet arrived at a solution.
Background: I have a CSV output from an application auditing tool, which spits out tonnes of app data from various computers. That CSV data will be copied into my master 'reporting' spreadsheet. I am only interested in reviewing and keeping data about specific applications, namely Chrome.exe, Firefox.exe, Acro32.exe and Winword.exe. The application name is always found in Column F. So, any cell contents found in Column F, that DOES NOT contain a value in an array, that entire row needs to be deleted. Ideally :) and the remaining rows will only include apps I'm interested in as defined in the array.
Any thoughts would be appreciated. I have posted on another forum and will update this forum with the response in case it helps someone else should one occur (and vice versa).
Thanks



<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">PublicFunction GetLastRow(ByVal rngToCheck As Range)AsLong

Dim rngLast As Range

Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)

If rngLast IsNothingThen
GetLastRow
= rngToCheck.Row
Else
GetLastRow
= rngLast.Row
EndIf

EndFunction

Sub Apps_Formatting()

Dim varList AsVariant
Dim lngLastRow AsLong, lngCounter AsLong
Dim rngToCheck As Range, rngFound As Range
Dim rngToDelete As Range, rngDifferences As Range
Dim blnFound AsBoolean

Application
.ScreenUpdating =False

With ActiveSheet
lngLastRow
= GetLastRow(.Cells)

'we don't want to delete our header row
Set rngToCheck =.Range("A2:A"& lngLastRow)
EndWith

If lngLastRow >1Then

With rngToCheck

'any Cell in Column F that contains one of these values are KEPT
'and if not found in cell, then the entire row is deleted.

varList
= VBA.Array("Chrome.exe","Firefox.exe","Acro32.exe")

For lngCounter = LBound(varList)To UBound(varList)

Set rngFound =.Find( _
what
:=varList(lngCounter), _
Lookat
:=xlWhole, _
searchorder
:=xlByRows, _
searchdirection
:=xlNext, _
MatchCase
:=True)

'check if we found a value we want to keep
IfNot rngFound IsNothingThen

blnFound
=True

'if there are no cells with a different value then
'we will get an error
OnErrorResumeNext
Set rngDifferences =.ColumnDifferences(Comparison:=rngFound)
OnErrorGoTo0

IfNot rngDifferences IsNothingThen
If rngToDelete IsNothingThen
Set rngToDelete = rngDifferences
Else
Set rngToDelete = Application.Intersect(rngToDelete, rngDifferences)
EndIf
EndIf

EndIf

Next lngCounter
EndWith

If rngToDelete IsNothingThen
IfNot blnFound Then rngToCheck.EntireRow.Delete
Else
rngToDelete
.EntireRow.Delete
EndIf
EndIf

Application
.ScreenUpdating =True

EndSub</code>
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
2,006
I got a little lost reading the code you have. This code does what you ask. You can add elements to the array and you need to change the sheet name to whatever yours is called. I've highlighted both of these in red

This code can go in a std module which I assume you know how to create (or can just be pasted in the code module of the sheet you are cleaning)

IMPORTANT: Test on a copy of your data as items are deleted

Code:
Sub TidyUp()
    Dim ws As Worksheet 'worksheet to be 'tidied'
    Dim fr As Long, lr As Long 'frist row and last row of data
    Dim l1 As Long, i As Integer 'counters
    Dim sList() As String
    
    'Handle errors
    On Error GoTo errHandle
    
    'create string array. You can add any other string values here delimited with a comma
    sList = Split("[B][COLOR=#ff0000]Chrome.exe,Firefox.exe,Acro32.exe,Winword.exe[/COLOR][/B]", ",")
    
    'change Sheet1 to your sheet name
    Set ws = Worksheets("[B][COLOR=#ff0000]Sheet1[/COLOR][/B]")
    
    fr = 2 'guessing that your first row of data is row 2, change if not
    lr = ws.Range("F" & Rows.Count).End(xlUp).Row 'last used row in column F
    
    'disable events to speed up
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    'must start at bottom and work up as we are deleting rows
    For l = lr To fr Step -1
        For i = 0 To UBound(sList)
            If InStr(1, ws.Cells(l, "F"), sList(i)) > 0 Then
                ws.Rows(l).Delete
                Exit For
            End If
        Next i
    Next l
    
    'Re-enable
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


'If error this executes
errHandle:
    'display error text
    MsgBox Err.Description
    'Re-enable
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,958
Office Version
  1. 365
Platform
  1. Windows
Any thoughts would be appreciated. I have posted on another forum and will update this forum with the response in case it helps someone else should one occur (and vice versa).
Thanks


You need to put the link (the link to your post in another forum) here & vice versa.

Here's another way:

Code:
[B][COLOR=Royalblue]Sub[/COLOR][/B] a1077712b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1077712-vba-remove-rows-xlsx-where-particular-text-can-found-within-cell.html[/COLOR][/I]
[B][COLOR=Royalblue]Dim[/COLOR][/B] i [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], r [B][COLOR=Royalblue]As[/COLOR][/B] Range
[B][COLOR=Royalblue]Dim[/COLOR][/B] va [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Variant[/COLOR][/B], arr [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Variant[/COLOR][/B], flag [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Boolean[/COLOR][/B]
arr = Array([COLOR=brown]"Chrome.exe"[/COLOR], [COLOR=brown]"Firefox.exe"[/COLOR], [COLOR=brown]"Acro32.exe"[/COLOR], [COLOR=brown]"Winword.exe"[/COLOR])
[B][COLOR=Royalblue]Set[/COLOR][/B] r = Range([COLOR=brown]"F2"[/COLOR], Cells(Rows.count, [COLOR=brown]"F"[/COLOR]).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp))
va = r

[B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] UBound(va, [COLOR=crimson]1[/COLOR])
    flag = [B][COLOR=Royalblue]False[/COLOR][/B]
        [B][COLOR=Royalblue]For[/COLOR][/B] [B][COLOR=Royalblue]Each[/COLOR][/B] x [B][COLOR=Royalblue]In[/COLOR][/B] arr
            [B][COLOR=Royalblue]If[/COLOR][/B] InStr([COLOR=crimson]1[/COLOR], va(i, [COLOR=crimson]1[/COLOR]), x, [COLOR=crimson]1[/COLOR]) > [COLOR=crimson]0[/COLOR] [B][COLOR=Royalblue]Then[/COLOR][/B] flag = [B][COLOR=Royalblue]True[/COLOR][/B]: [B][COLOR=Royalblue]Exit[/COLOR][/B] [B][COLOR=Royalblue]For[/COLOR][/B]
        [B][COLOR=Royalblue]Next[/COLOR][/B]
    [B][COLOR=Royalblue]If[/COLOR][/B] flag = [B][COLOR=Royalblue]False[/COLOR][/B] [B][COLOR=Royalblue]Then[/COLOR][/B] va(i, [COLOR=crimson]1[/COLOR]) = [COLOR=brown]""[/COLOR]
[B][COLOR=Royalblue]Next[/COLOR][/B]

r = va
r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]
 

novadon

New Member
Joined
Nov 15, 2018
Messages
3
Hey, want to say thanks so much to the both of you, i found the sample below worked (Sub a1077712b) - you wont believe how much of time saver this will be. I'll link this thread into the other forum.





You need to put the link (the link to your post in another forum) here & vice versa.

Here's another way:

Code:
[B][COLOR=Royalblue]Sub[/COLOR][/B] a1077712b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1077712-vba-remove-rows-xlsx-where-particular-text-can-found-within-cell.html[/COLOR][/I]
[B][COLOR=Royalblue]Dim[/COLOR][/B] i [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], r [B][COLOR=Royalblue]As[/COLOR][/B] Range
[B][COLOR=Royalblue]Dim[/COLOR][/B] va [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Variant[/COLOR][/B], arr [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Variant[/COLOR][/B], flag [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Boolean[/COLOR][/B]
arr = Array([COLOR=brown]"Chrome.exe"[/COLOR], [COLOR=brown]"Firefox.exe"[/COLOR], [COLOR=brown]"Acro32.exe"[/COLOR], [COLOR=brown]"Winword.exe"[/COLOR])
[B][COLOR=Royalblue]Set[/COLOR][/B] r = Range([COLOR=brown]"F2"[/COLOR], Cells(Rows.count, [COLOR=brown]"F"[/COLOR]).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp))
va = r

[B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] UBound(va, [COLOR=crimson]1[/COLOR])
    flag = [B][COLOR=Royalblue]False[/COLOR][/B]
        [B][COLOR=Royalblue]For[/COLOR][/B] [B][COLOR=Royalblue]Each[/COLOR][/B] x [B][COLOR=Royalblue]In[/COLOR][/B] arr
            [B][COLOR=Royalblue]If[/COLOR][/B] InStr([COLOR=crimson]1[/COLOR], va(i, [COLOR=crimson]1[/COLOR]), x, [COLOR=crimson]1[/COLOR]) > [COLOR=crimson]0[/COLOR] [B][COLOR=Royalblue]Then[/COLOR][/B] flag = [B][COLOR=Royalblue]True[/COLOR][/B]: [B][COLOR=Royalblue]Exit[/COLOR][/B] [B][COLOR=Royalblue]For[/COLOR][/B]
        [B][COLOR=Royalblue]Next[/COLOR][/B]
    [B][COLOR=Royalblue]If[/COLOR][/B] flag = [B][COLOR=Royalblue]False[/COLOR][/B] [B][COLOR=Royalblue]Then[/COLOR][/B] va(i, [COLOR=crimson]1[/COLOR]) = [COLOR=brown]""[/COLOR]
[B][COLOR=Royalblue]Next[/COLOR][/B]

r = va
r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,301
Office Version
  1. 365
Platform
  1. Windows
@novadon
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
 

novadon

New Member
Joined
Nov 15, 2018
Messages
3
@novadon
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.


When I started to look into this problem I posted a question here https://stackoverflow.com/questions...-can-be-found-within-a-cell/53318142#53318142

The question didn't get answered as of 17/11/2018 , so updated the original threat on StackOverflow to link back to this thread.

Hope that clarifies things.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,093
Messages
5,622,655
Members
415,917
Latest member
kungsleden

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top