VBA searching for text and entering a value if true

JBD7379

New Member
Joined
Jul 30, 2020
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
Hello,

My worksheet has a couple hundred columns and 20k rows. My task is to search for specific keywords in the text within each cell within each row and then write in "yes" or "no" if there is a match in the first column of each row. For example: searching for "dog", "cat", or "horse' in multiple cells of a row all containing various strings of text, if there is a match to any of those I'd enter "yes" in cell A1, and "no" if there is no match. I've figured out the search and write aspect of this task for a single line, but when I attempt to add in any functionality to fill down or repeat the formula for every row in my matrix the code fails. How do I get the macro to repeat the search and write functionality for every row in my matrix?

My test search range would be in cells "B8:D20".
My write-to cells would be in column A of each row. "A8:A20"


Sub Search_Range_For_Text()
Dim cell As Range
Dim row As Range
Dim rng As Range

Set rng = Range("b8:d20")

For Each row In rng.Rows
For Each cell In row.Cells
If InStr(cell.Value, "dog") > 0 Then
Cells(row.Rows, 1).Value2 = "yes" //this is my problem line
ElseIf InStr(cell.Value, "cat") > 0 Then
Cells(row.Rows, 1).Value2 = "yes"
ElseIf InStr(cell.Value, "horse") > 0 Then
Cells(row.Rows, 1).Value2 = "yes"
Else
Cells(row.Rows, 1).Value2 = "no"
End If
Next cell
Next row

End Sub

Thanks in advance for any help offered.
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Ezguy4u

Board Regular
Joined
Feb 10, 2010
Messages
143
Office Version
  1. 2019
Platform
  1. Windows
Just to get the ball rolling
Now you will notice that catastrophic generates a Yes. So if you use this program you just have to be sure that the words you are looking for don't include a word like catastrophic.
Sub exper1()

Dim row1 As Integer
Dim col1 As Integer

For row1 = 8 To 20

For col1 = 2 To 4

Cells(row1, col1).Select

If Cells(row1, col1) Like "*cat*" Or Cells(row1, col1) Like "*horse*" Or Cells(row1, col1) Like "*dog*" Then
Cells(row1, 1) = "Yes"

End If


Next col1

Next row1

End Sub

20-07-30 2.xlsm
ABCD
1
2
3
4
5
6
7
8Yes the cat came backBC
9YesDRun the horseF
10GAH
11YesIJbuild a dog house
12KLK
13YesIt was a catastrophe N O
14ABC
15PQR
16STU
17Yesbuild a dog houseWX
18BCA
19YesMORun the horse
20CBA
Add Yes
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,712
Office Version
  1. 2010
Platform
  1. Windows
What should the result be if a word is embedded within a larger word? For example, would "Yes" be returned for the word "concatenation"?
 

JBD7379

New Member
Joined
Jul 30, 2020
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
@Ezguy4u Thank you! This worked like a charm!

@Rick I can't really comment on your thought. The search words in my actual project are more complex, so the containment issue isn't really a concern for me. I do see your point about placement possibly being an issue for people searching for small words like "cat" though.

Thanks, everyone for your comments. I'd consider this issue resolved.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

@Ezguy4u Thank you! This worked like a charm!

Thanks, everyone for your comments. I'd consider this issue resolved.
⚡ Are you sure?
  • The code suggested is case-sensitive so unless all your 'words-of-interest' in your actual data are lower case it will not pick up all matches.

  • You said you had a couple of hundred columns and 20,000 rows. Have you tested the code on data that big? :eek:

Here is an alternative for the small sample size you gave.

VBA Code:
Sub SearchForStrings_v1()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, uba2 As Long

  Const myStrings As String = "cat|horse|dog"

  Set RX = CreateObject("VBScript.RegExp")
  RX.IgnoreCase = True
  RX.Pattern = myStrings
  a = Range("B8:D20").Value
  uba2 = UBound(a, 2)
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    b(i, 1) = "No"
    For j = 1 To uba2
      If RX.Test(a(i, j)) Then
        b(i, 1) = "Yes"
        Exit For
      End If
    Next j
  Next i
  Range("A8").Resize(UBound(b)).Value = b
End Sub


This code can be adapted for large data but for me to do that I would need some way to know how to work out what the last column is and what the last row is. We can come back to that if you are interested in this method.

To demonstrate the size issue, I made up some sample data of just 9 columns (B:J) and 1000 rows.
The (adapted) code from post 2 took 7.4 seconds with my sample data (which may or may not be representative of yours)
The (adapted) code above took 0.016 seconds on the same data. That is >400 times faster!
Extended to 200 columns and 20,000 rows the actual time difference would be enormous!!
 

JBD7379

New Member
Joined
Jul 30, 2020
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
@Peter_SSs You're right on the case sensitivity and the computation time. I adjusted the sample code to include upper and lower case first letters to account for the potential conflict, which isn't ideal, but it worked. The total time to process my database took about 25 minutes too, given its size and my tiny HP work laptop I figured that was acceptable. If I have to do it again I'll use your template instead. Thanks for the added recommendation!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
You're welcome. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,265
Messages
5,600,605
Members
414,393
Latest member
Vignesh Mechz

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