Search for multiple keyphrases

**tshrader** · 12-12-2011, 11:57 AM

Hello VBA coders, I am in dire need of VBA code that will perform the following task:

Situation:
Column G39:G3403 contains google search results. I need to search within each of those cells, one-by-one, for one of many keywords/phrases. Column R2:R37 contains the unique keywords/phrases. I need VBA code that will search for these keyphrases, one-by-one, in the the google search results, one-by-one. If there is at least one match, then a string contained in R38 needs to be inserted into the cell in column R in the row of the associated google search result.

Column G39:G3403 contains google search results.
Column R2:R37 contains keywords/phrases
Cell R38 contains the string to be inserted if there is a positive match
Column R39:R3403 is where the string in R38 needs to be inserted if there is a positive match.

I am currently achieving my needs by placing this cell function in each cell in column R39:R3403
=IF((OR(NOT(ISERR(SEARCH(R$2,$G39))),NOT(ISERR(SEARCH(R$3,$G39))),NOT(ISERR(SEARCH(R$4,$G39))),NOT(I SERR(SEARCH(R$5,$G39))),,NOT(ISERR(SEARCH(R$6,$G39))),NOT(ISERR(SEARCH(R$7,$G39))),NOT(ISERR(SEARCH( R$8,$G39))),NOT(ISERR(SEARCH(R$9,$G39))),NOT(ISERR(SEARCH(R$10,$G39))),NOT(ISERR(SEARCH(R$11,$G39))) ,NOT(ISERR(SEARCH(R$12,$G39))),NOT(ISERR(SEARCH(R$13,$G39))),NOT(ISERR(SEARCH(R$14,$G39))),NOT(ISERR (SEARCH(R$15,$G39))),NOT(ISERR(SEARCH(R$16,$G39))),NOT(ISERR(SEARCH(R$17,$G39))),NOT(ISERR(SEARCH(R$ 18,$G39))),NOT(ISERR(SEARCH(R$19,$G39))),NOT(ISERR(SEARCH(R$20,$G39))),NOT(ISERR(SEARCH(R$21,$G39))) ,NOT(ISERR(SEARCH(R$22,$G39))),NOT(ISERR(SEARCH(R$23,$G39))),NOT(ISERR(SEARCH(R$24,$G39))),NOT(ISERR (SEARCH(R$25,$G39))),NOT(ISERR(SEARCH(R$26,$G39))),NOT(ISERR(SEARCH(R$27,$G39))),NOT(ISERR(SEARCH(R$ 28,$G39))),NOT(ISERR(SEARCH(R$29,$G39))),NOT(ISERR(SEARCH(R$30,$G39))),NOT(ISERR(SEARCH(R$31,$G39))) ,NOT(ISERR(SEARCH(R$32,$G39))),NOT(ISERR(SEARCH(R$33,$G39))),NOT(ISERR(SEARCH(R$34,$G39))),NOT(ISERR (SEARCH(R$35,$G39))),NOT(ISERR(SEARCH(R$36,$G39))),NOT(ISERR(SEARCH(R$37,$G39)))))=TRUE,R$38,"")

This wouldn't be so bad if I didn't have a different set of keywords/phrases from range R2:R37 all the way to DV2:DV37, but I do and they need to be separate.

If this is too much to ask, I apologize. I'm trying to learn VBA code, but it has been a slow process. If you can help, I will greatly appreciate it. Also, I will have many upcoming VBA projects like this that I wouldn't mind paying someone for, so if you're a smart VBA coder and you want some random work, I will gladly pay you. If you're interested, send me a message with your availability and price per hour. I have several projects that need to be done within the next 2 weeks. We can start asap.

Thank you, Ladies and/or Gentlemen.

**Decoderman** · 12-12-2011, 12:09 PM

can you attach a test workbook?

**tigeravatar** · 12-12-2011, 12:15 PM

tshrader,

Assuming there are no blanks in the range R2:DV37, then this array formula should work for you (this goes in cell R39):
=IF(OR(COUNTIF(G39,"*"&$R$2:$DV$37&"*")),$R$38,"")

An array formula needs to be entered with Ctrl+Shift+Enter and not just Enter. Then copy down to R3403

**tshrader** · 12-12-2011, 12:28 PM

Multiple Keyphrase search - VBA code (Test file).xlsx

Here is a test file. This should help. I need VBA code that won't leave a trace of the formula. It's copying the formula to 100,000+ cells that I want to avoid. Slows excel down to an agonizing crawl.

Thank you very much for your help.

**tshrader** · 12-12-2011, 12:56 PM

Thank you for your help, tigeravatar, but I want to avoid having to copy a formula to all 336,000+ cells in the range R38:DV3403. If you look at the attached excel sheet, I think you'll understand my situation better. Thanks, again!

**tigeravatar** · 12-12-2011, 01:02 PM

tshrader,

Macro version. Inputs the formula to all necessary cells, then converts formula to just the values so that the formula doesn't exist in those cells anymore. May take a minute or two to complete:

Sub KeyphraseSearchMacro_for_tshrader()
    
    Dim LastRow As Long: LastRow = Cells(Rows.Count, "G").End(xlUp).Row
    
    Range("R39").FormulaArray = "=IF(OR(COUNTIF($G39,""*""&R$2:R$37&""*"")),R$38,"""")"
    Range("R39").Copy Range("R39:DV39")
    Range("R39:DV39").Copy Range("R40:R" & LastRow)
    Range("R39:DV" & LastRow).Value = Range("R39:DV" & LastRow).Value
    
End Sub

**tshrader** · 12-12-2011, 01:19 PM

tigeravatar,

When I run this, I get an error message saying "Run-time error '1004', You cannot change part of an array. When I go to Debug, it highlights this row: Range("R39").Copy Range("R39:DV39"). I don't know what that means...

**tigeravatar** · 12-12-2011, 01:26 PM

tshrader,

Give this a try. It uses an R1C1 style formula. Note that it is still for the ranges from your original post, and not the ranges for the example workbook.

Sub KeyphraseSearchMacro_for_tshrader()
    
    Dim LastRow As Long: LastRow = Cells(Rows.Count, "G").End(xlUp).Row
    
    Range("R39").FormulaArray = "=IF(OR(COUNTIF(RC7,""*""&R2C:R37C&""*"")),R38C,"""")"
    Range("R39").Copy Range("R39:DV39")
    Range("R39:DV39").Copy Range("R40:R" & LastRow)
    Range("R39:DV" & LastRow).Value = Range("R39:DV" & LastRow).Value
    
End Sub

**tigeravatar** · 12-12-2011, 01:28 PM

Hmm.. nevermind, I get same error when I test it. Will work on different approach

**tshrader** · 12-12-2011, 02:00 PM

tigeravater,

I also get the same error message again.

**tigeravatar** · 12-12-2011, 03:43 PM

tshrader,

This code runs successfully on the example workbook you provided and has a runtime of about 11 seconds on the example workbook:

Sub KeyphraseSearchMacro_for_tshrader()
    
    Dim rngPhrase As Range
    Dim rngVis As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    With Range("A38", Cells(Rows.Count, "A").End(xlUp))
        For Each rngPhrase In Range("B2:P37")
            .AutoFilter 1, "*" & rngPhrase.Value & "*"
            Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            If Not rngVis Is Nothing Then
                Intersect(rngVis.EntireRow, Columns(rngPhrase.Column)).Value = Cells(38, rngPhrase.Column).Value
                Set rngVis = Nothing
            End If
        Next rngPhrase
        .AutoFilter
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

**tshrader** · 12-12-2011, 04:58 PM

Very nice, tigeravatar, works like a charm! Thank you very much.

**tshrader** · 02-08-2012, 01:13 PM

How can I modify the program below to exclude the keyphrase "_______" and go on to the next? In other words, if the program finds the value "_______" in any cell within the range B2:P37, it will skip it and go to the next.

Any help is greatly appreciated.

Thanks!

Sub KeyphraseSearchMacro_for_tshrader()

Dim rngPhrase As Range
Dim rngVis As Range

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

On Error Resume Next
With Range("A38", Cells(Rows.Count, "A").End(xlUp))
For Each rngPhrase In Range("B2:P37")
.AutoFilter 1, "*" & rngPhrase.Value & "*"
Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
If Not rngVis Is Nothing Then
Intersect(rngVis.EntireRow, Columns(rngPhrase.Column)).Value = Cells(38, rngPhrase.Column).Value
Set rngVis = Nothing
End If
Next rngPhrase
.AutoFilter
End With

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

**tigeravatar** · 02-08-2012, 01:19 PM

Something like this should work:

Sub KeyphraseSearchMacro_for_tshrader()
    
    Const KeyPhrase As String = "_______"
    
    Dim rngPhrase As Range
    Dim rngVis As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    With Range("A38", Cells(Rows.Count, "A").End(xlUp))
        For Each rngPhrase In Range("B2:P37")
            If rngPhrase.Value <> KeyPhrase Then
                .AutoFilter 1, "*" & rngPhrase.Value & "*"
                Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
                If Not rngVis Is Nothing Then
                    Intersect(rngVis.EntireRow, Columns(rngPhrase.Column)).Value = Cells(38, rngPhrase.Column).Value
                    Set rngVis = Nothing
                End If
            End If
        Next rngPhrase
        .AutoFilter
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

**tshrader** · 02-08-2012, 01:41 PM

Perfect! Once again, tigeravatar, you are awesome.

Thanks!

Thread: Search for multiple keyphrases

Thread Tools

Display

Search for multiple keyphrases

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Re: Search for multiple keyphrases, one at a time, in a column of google search resul

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions