Using VBA, how can I search for multiple strings within a defined range? - excel

Question

If I have a long list of text in Column A, and a short list of words in Column C, what would be the best way to go about searching each cell in A for any of the words in C, and copy and paste the ones that match out into Column B?
The code I have written so far is as follow
Sub ListKeywordQualifier()
Dim Rng As Range
Dim Keyword As Range
Dim Chunk As Range
Dim x As Long
x = 1
While x <= 5000
Set Rng = Range("A" & x)
Set Chunk = Range("C1", "C100")
Application.ScreenUpdating = True
Range("D1").Value = x
If Application.WorksheetFunction.CountIf(Chunk, Rng) = 0 Then
x = x + 1
ElseIf Application.WorksheetFunction.CountIf(Chunk, Rng) = 1 Then
Rng.Copy
Rng.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
x = x + 1
End If
Wend
End Sub
However, this will onl;y give me exact matches between the two. Is it possible to do the same, but have text that appears in Column C, while only making up part of Column A, trigger the copy/paste line?
Thanks

Answer 1

your countif is not working because it is a worksheet function, to implement countif.... you need to write it like
WorksheetFunction.CountIf . Still your code is not looking Good , Try This!
Sub ListKeywordQualifier()
Dim Rng(50) As String
Dim Chunk(50) As String
Dim i As Long
i = 1
'' Take a value From 3rd Column this works for 10 cells ,
For i = 1 To 10
Chunk(i) = Cells(i, 3)
''Search it in 1st Column in 10 cells
For j = 1 To 10
Rng(j) = Cells(j, 1)
''If it matches
If Chunk(i) = Rng(j) Then
''Then copy that value to Second Column
Cells(i, 2).Value = Rng(j)
End If
Next j
Next i
End Sub
This is just to give you an idea , you still need make changes Thanks

Answer 2

Consider:
Sub ListKeywordQualifier()
Dim A As Range, C As Range, aa As Range, cc As Range
Dim K As Long, va, vc, boo As Boolean
Set A = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set C = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
K = 1
For Each aa In A
va = aa.Value
boo = False
For Each cc In C
If InStr(1, va, cc.Value) > o Then boo = True
Next cc
If boo Then
aa.Copy Cells(K, "B")
K = K + 1
End If
Next aa
End Sub
Before:
and after: