Macro to Keep Only Rows with The Word Saturday

[Daren]

Hello,
I have two columns that can contain the word Saturday in text values of any
length. The word Saturday can appear in any cell in column D and E. Is
there a macro that I can write to delete any row that do not contain the word
Saturday in column D and E? Thanks.

 

[Mike H]

Hi,

I'm not sure if you want 'Saturday' in both or either of columns D & E.
Right click your sheet tab, view code and paste this in and run it and it
look for saturday in both columns

Change this
If InStr(UCase(c), "SATURDAY") > 0 And InStr(UCase(c.Offset(,

to this
If InStr(UCase(c), "SATURDAY") > 0 OR InStr(UCase(c.Offset(,
if it's either

Sub I_Dont_Like_Saturdays()
Dim DelRange As Range
Dim LastRowD As Long, LastrowE As Long
LastRowD = Cells(Cells.Rows.Count, "D").End(xlUp).Row
LastrowE = Cells(Cells.Rows.Count, "E").End(xlUp).Row
Set MyRange = Range("D1" & WorksheetFunction.Max(LastRowD, LastrowE))
For Each c In MyRange
If InStr(UCase(c), "SATURDAY") > 0 And InStr(UCase(c.Offset(, 1)),
"SATURDAY") > 0 Then
If DelRange Is Nothing Then
Set DelRange = c.EntireRow
Else
Set DelRange = Union(DelRange, c.EntireRow)
End If
End If
Next

If Not DelRange Is Nothing Then
DelRange.Select
End If
End Sub



Mike

 

[Mike H]

OOPs,

I got it the wrong way around you want to keep Saturday

Sub I_Like_Saturdays()
Dim DelRange As Range
Dim LastRowD As Long, LastrowE As Long
LastRowD = Cells(Cells.Rows.Count, "D").End(xlUp).Row
LastrowE = Cells(Cells.Rows.Count, "E").End(xlUp).Row
Set MyRange = Range("D1" & WorksheetFunction.Max(LastRowD, LastrowE))
For Each c In MyRange
If InStr(UCase(c), "SATURDAY") = 0 And InStr(UCase(c.Offset(, 1)),
"SATURDAY") = 0 Then
If DelRange Is Nothing Then
Set DelRange = c.EntireRow
Else
Set DelRange = Union(DelRange, c.EntireRow)
End If
End If
Next

If Not DelRange Is Nothing Then
DelRange.Delete
End If
End Sub


Mike

 

[Rick Rothstein]

If InStr(UCase(c), "SATURDAY") = 0 And ....

You don't have to use the UCase function with InStr that way...InStr has an
optional parameter to handle text casing. The above code fragment could be
done this way also...

If InStr(1, c, "Saturday", vbTextCompare) = 0 And ...

 

[Rick Rothstein]

If InStr(UCase(c), "SATURDAY") = 0 And InStr(UCase(c.Offset(, 1)),
While I would probably use the InStr method myself, as an aside, the above
test could also be done this way...

If c & c.Offset(, 1) like "*[Ss][Aa][Tt][Uu][Rr][Dd][Aa][Yy]*" Then

Although, if there is **any** chance that the end of Column D's text
concatenated onto Column E's text could produce the word "Saturday" (in any
casing arrangement) at the "join point", then place an intervening character
(any character will do) between them to eliminate that possibility...

If c & "-" & c.Offset(, 1) like "*[Ss][Aa][Tt][Uu][Rr][Dd][Aa][Yy]*" Then

Though, for either of the two Like Operator constructions, it might be
better to use the UCase function...

If UCase(c & "." & c.Offset(, 1)) like "*SATURDAY*" Then

 

[Daren]

Thanks, Mike. I will try something similar as I'm not actually searching for
Saturday...I just wanted to keep the data kinda private. Sorry about that.
I was looking at my data sets and realized that what I actually want to find
is "pharmacy", "pharmacies", "drug" or "drugs" in text strings of any length
in columns D and E but that won't count records twice if the macro 'sees' a
pharmacy, pharmacies, drug, or drugs under columns D and E in the same record
.. Would you be kind enough to step me through that process with a macro?
Thanks again!

 

[Mike H]

Daren,

There are 2 approaches to this, you could hold all of the values to keep in
an array or a worksheet range and this approach uses the latter with the
range of value to keep being stored on Sheet 2 in Column A1 down.

Once again right click the sheet tab with your data, view code and paste
this in and run it. Also note that if you use INSTR in future be aware of
Rick's guidance on it's use (Thanks Rick)

Sub I_Like_Saturdays()
Dim DelRange As Range, CompRange As Range
Dim LastRowD As Long, LastrowE As Long, LastRowA As Long
LastRowD = Cells(Cells.Rows.Count, "D").End(xlUp).Row
LastrowE = Cells(Cells.Rows.Count, "E").End(xlUp).Row
LastRowA = Sheets("Sheet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set CompRange = Sheets("Sheet2").Range("A1:A" & LastRowA)
Set MyRange = Range("D1" & WorksheetFunction.Max(LastRowD, LastrowE))
For Each c In MyRange
If WorksheetFunction.CountIf(CompRange, c.Value) = 0 _
And WorksheetFunction.CountIf(CompRange, c.Offset(, 1).Value) = 0 Then
If DelRange Is Nothing Then
Set DelRange = c.EntireRow
Else
Set DelRange = Union(DelRange, c.EntireRow)
End If
End If
Next
If Not DelRange Is Nothing Then
DelRange.delete
End If
End Sub


Mike

 

[Mike H]

Ignore that last load of tosh your still using instr, still with a lest to
keep in shet 2, try this

Dim LastRowD As Long, LastrowE As Long, LastRowA As Long
LastRowD = Cells(Cells.Rows.Count, "D").End(xlUp).Row
LastrowE = Cells(Cells.Rows.Count, "E").End(xlUp).Row
LastRowA = Sheets("Sheet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set CompRange = Sheets("Sheet2").Range("A1:A" & LastRowA)
Set MyRange = Range("D1" & WorksheetFunction.Max(LastRowD, LastrowE))
For Each c In MyRange
DelFlag = True
For Each d In CompRange
If InStr(1, c, d, vbTextCompare) > 0 Or InStr(1, c.Offset(, 1), d,
vbTextCompare) > 0 Then
DelFlag = False
Exit For
End If
Next
If DelFlag Then
If DelRange Is Nothing Then
Set DelRange = c.EntireRow
Else
Set DelRange = Union(DelRange, c.EntireRow)
End If
End If
Next
If Not DelRange Is Nothing Then
DelRange.delete
End If
End Sub

Mike