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

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

Do you want the column A cell copied to C or the B cell copied ?? — Gary's Student
– Gary's Student, Commented Feb 5, 2016 at 12:39
Apologies, I've made an error in the script. It has since been edited. It's the A cells I would like copied. — user1996971
– user1996971, Commented Feb 5, 2016 at 12:42

Sayyed Abbas Rizvi · Accepted Answer · 2016-02-05 13:11:10Z

2

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

answered Feb 5, 2016 at 13:11

Sayyed Abbas Rizvi

1021 silver badge9 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Sayyed Abbas Rizvi Over a year ago

Sorry I am on my Phone Right Now , Hope this helps you

Gary's Student · Accepted Answer · 2016-02-05 13:29:25Z

1

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:

answered Feb 5, 2016 at 13:29

Gary's Student

96.9k10 gold badges66 silver badges104 bronze badges

2 Comments

user1996971 Over a year ago

This is perfect. Thank you! :)

Gary's Student Over a year ago

@user1996971 Update this if you have any problems!

Collectives™ on Stack Overflow

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

2 Answers 2

1 Comment

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related