VBA search function

[adrianbuliga]

hello,
Please help me with a code for something that…i consider…complicated
To be more explicit, I’ll give you an example (my table has around 500 rows and continuously piles-up):
I have a table like this:

	A	B
1	January	31
2	February	28
3	March	31
4	April	30
5	May	31
6	June	30

<tbody>
</tbody>

and I want a VBA macro that will search on the B column for a specific text, let’s say „ARY”, meaning that I want to search also inside the words, not only words that begin with (as an observation some cells has more than 1 word)… and return somewhere on the sheet (or on another sheet) a new table that will contain ONLY the rows that meets the criteria. In this case would be:

	A	B
15	January	31
16	February	28

<tbody>
</tbody>

Thank you in advance for help,
Adrian

 

[MickG]

Try this for results in Columns"D & E"

[COLOR="Navy"]Sub[/COLOR] MG18Sep04
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] InStr(Dn.Value, "ary") > 0 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Cells(c, "D") = Dn.Value
        Cells(c, "E") = Dn.Offset(, 1)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[vds1]

Another Method..

Sub Filter_Copy_Paste()
Dim LastRow As Long
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Select
With Range("$A$1:$B$" & LastRow)
    .AutoFilter Field:=1, Criteria1:="=*ary*", Operator:=xlAnd
    .Copy Sheets("Sheet2").Range("A1")
End With
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Range("A1").Select
End Sub

 

[adrianbuliga]

Thank you very much guys!
Really helpful

Adrian,