MACRO

[xxsalahxx]

Hello im using the macro below and it is working well, however, i need to add to this to extract not only the word RED but also BLUE is there anyway to add to this macro to do this?
Thank you in advance.

Sub Foo()
Dim Cl As Range
Dim i As Long
Dim aTokens As String

i = 5
aTokens = ("RED")
With Sheets("DATA")
For Each Cl In .Range("C5", .Range("C" & Rows.Count).End(xlUp))
If InStr(1, Cl.Value, aTokens, vbTextCompare) Then
Cl.EntireRow.Copy Sheets("data red and blue").Rows(i)
i = i + 1
End If
Next Cl
End With
End Sub

 

[maabadi]

Try this:

Sub Foo()
Dim Cl As Range, i As Long, aTokens As String, bTokens As String

i = 5
aTokens = ("RED")
bTokens = ("BLUE")
With Sheets("DATA")
For Each Cl In .Range("C5", .Range("C" & Rows.Count).End(xlUp))
If InStr(1, Cl.Value, aTokens, vbTextCompare) Or InStr(1, Cl.Value, bTokens, vbTextCompare) Then
Cl.EntireRow.Copy Sheets("data red and blue").Rows(i)
i = i + 1
End If
Next Cl
End With
End Sub

 

[xxsalahxx]

Im afraid thats not working any other ideas?
Thank you for replying so quickly

 

[xxsalahxx]

Sorry it is working PERFECTLY!!

Thank you so much

 

[maabadi]

You're welcome & Thanks for Feedback.