Multiple search and copy
 

I am looking to find instances of words within a url that is in a column.
Then select the rows that contain any words from a list and then copy those
selected rows to a second sheet.

I would like to be able to add words and use regular expressions for some
words.

EG
I would like to find the following
Chat
Face*
Bebo*
Any help would be most appreciated.

Multiple search and copy
 

Sub finddate()
SearchCol = "A"

words = Array("Chat", "Face*", "Bebo*")

With Sheets("Sheet1")
For Each phrase In words

If Right(phrase, 1) = "*" Then

Set c = Columns(SearchCol & ":" & SearchCol). _
Find(what:=phrase, LookIn:=xlValues, _
lookat:=xlPart)
Else
Set c = Columns(SearchCol & ":" & SearchCol). _
Find(what:=phrase, LookIn:=xlValues, _
lookat:=xlWhole)
End If
If Not c Is Nothing Then
With Sheets("Sheet2")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
c.EntireRow.Copy _
Destination:=.Rows(LastRow)
End With
End If
Next phrase
End With

End Sub


"BC" wrote:

I am looking to find instances of words within a url that is in a column.
Then select the rows that contain any words from a list and then copy those
selected rows to a second sheet.

I would like to be able to add words and use regular expressions for some
words.

EG
I would like to find the following
Chat
Face*
Bebo*
Any help would be most appreciated.

Multiple search and copy
 

Joel

The only thing I have changed in your code was the column and the words
which did not work.

The columns I have are
WKS ID Date Time Proxy Site

The code below I was using works to an extent but only on single words and
it ends with an error but it does copy selected rows to Sheet2.

Sub test()
Dim FilterValue As String
Dim rng As Range
Dim rng2 As Range

Set rng = Range("F:F")
FilterValue = "*sports*"

rng.AutoFilter Field:=1, Criteria1:=FilterValue
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng2.EntireRow.Copy Sheets("Sheet2").Range("A1")
End If
End With
ActiveSheet.AutoFilterMode = False
End Sub

This is new to me and I am still trying to get my head round it.

Thanks very much.




"Joel" wrote:

Sub finddate()
SearchCol = "A"

words = Array("Chat", "Face*", "Bebo*")

With Sheets("Sheet1")
For Each phrase In words

If Right(phrase, 1) = "*" Then

Set c = Columns(SearchCol & ":" & SearchCol). _
Find(what:=phrase, LookIn:=xlValues, _
lookat:=xlPart)
Else
Set c = Columns(SearchCol & ":" & SearchCol). _
Find(what:=phrase, LookIn:=xlValues, _
lookat:=xlWhole)
End If
If Not c Is Nothing Then
With Sheets("Sheet2")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
c.EntireRow.Copy _
Destination:=.Rows(LastRow)
End With
End If
Next phrase
End With

End Sub


"BC" wrote:

I am looking to find instances of words within a url that is in a column.
Then select the rows that contain any words from a list and then copy those
selected rows to a second sheet.

I would like to be able to add words and use regular expressions for some
words.

EG
I would like to find the following
Chat
Face*
Bebo*
Any help would be most appreciated.

Multiple search and copy
 

try this to autofilter each and copy to next row in other sheet. Bypasses
"donald"

Sub findinurl()
myarray = Array("CHAT", "donald", "with", "Me")
mycol = "a"
destsheet = "sheet16"
lr = Cells(Rows.Count, mycol).End(xlUp).Row
On Error Resume Next
For Each c In myarray
Range("A1").AutoFilter Field:=1, Criteria1:="=*" & c & "*"
With Sheets(destsheet)
dlr = .Cells(Rows.Count, "a").End(xlUp).Row + 1
Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet16").Range("A" & dlr)
End With
Next c
Range("a1").AutoFilter
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"BC" wrote in message
...
I am looking to find instances of words within a url that is in a column.
Then select the rows that contain any words from a list and then copy
those
selected rows to a second sheet.

I would like to be able to add words and use regular expressions for some
words.

EG
I would like to find the following
Chat
Face*
Bebo*
Any help would be most appreciated.