Repeating search

[blastpwr1970]

Hi all,

I tried different things and nothing seems to work, could somebody please help me.

I need to search for MyText1, MyText2,.........MyText40.

The only way that I know how to do it is by repeting the code over and over again.

Is it posible to either do it with a lookup table or any other way?

I got too many part numbers to repeat the code over and over again.

Please help me.


In reference to http://www.vbaexpress.com/forum/showthread.php?t=8283

[vba]Option Explicit

Sub Macro1()

Dim i As Long, Txt As String
Dim Col1 As Range, Col2 As Range

Txt = "MyText"

Set Col1 = Intersect(Columns(Range("1:1").Find(What:="Look2", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)
Set Col2 = Intersect(Columns(Range("1:1").Find(What:="Test3", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)

For i = 1 To Col1.Rows.Count
If Col1(i) = True And Left(Col2(i), Len(Txt)) = Txt Then
Rows(i).Copy Sheets(2).Cells(65536, _
Col1.Column).End(xlUp).Offset(1, -Col1.Column + 1)
End If
Next

Txt = "MyText1"

Set Col1 = Intersect(Columns(Range("1:1").Find(What:="Look2", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)
Set Col2 = Intersect(Columns(Range("1:1").Find(What:="Test3", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)

For i = 1 To Col1.Rows.Count
If Col1(i) = True And Left(Col2(i), Len(Txt)) = Txt Then
Rows(i).Copy Sheets(2).Cells(65536, _
Col1.Column).End(xlUp).Offset(1, -Col1.Column + 1)
End If
Next

Txt = "MyText2"

Set Col1 = Intersect(Columns(Range("1:1").Find(What:="Look2", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)
Set Col2 = Intersect(Columns(Range("1:1").Find(What:="Test3", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)

For i = 1 To Col1.Rows.Count
If Col1(i) = True And Left(Col2(i), Len(Txt)) = Txt Then
Rows(i).Copy Sheets(2).Cells(65536, _
Col1.Column).End(xlUp).Offset(1, -Col1.Column + 1)
End If
Next

Sheets(2).Activate


End Sub
[/vba]

Thank you for all the help you can provide.

[OBP]

Just put another loop outside of the first loop that does your checking for mytext1
Either put the mytext values in to cells on the worksheet and move to each one in turn or set an array to hold your mytext1 to mytext40, it takes the form of
Dim mytext(40) as variant.
Or use an Input box that allows you to enter each of the 40 mytext values, but the loop is the key.

[blastpwr1970]

Hi

Sorry, I am very new to VB can somebody put a sample code.

Thank you

[OBP]

Try something like this, your various pieces of text, which are currently Mytext1 to Mytext4, are held in a String (called alltext) and seperated by commas. The outer loop finds each comma and sets mytext to each set of text in turn and then does your VB code. The message boxes do not need to be there they just show you what is happening with outer loop.

[VBA]
Dim i As Long, Txt As String
Dim Col1 As Range, Col2 As Range
Dim count As Integer, alltext As String, foundcomma
alltext = "txt1,txt2,txt3,txt4"
foundcomma = 1
For count = 1 To Len(alltext)
If Mid(alltext, count, 1) = "," Then
mytext = Mid(alltext, foundcomma, count - foundcomma)
MsgBox "found " & mytext & " at " & count
foundcomma = count + 1

Txt = "MyText"

Set Col1 = Intersect(Columns(Range("1:1").Find(What:="Look2", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)
Set Col2 = Intersect(Columns(Range("1:1").Find(What:="Test3", LookIn:=xlValues, _
LookAt:=xlWhole).Column), ActiveSheet.UsedRange)

For i = 1 To Col1.Rows.count
If Col1(i) = True And Left(Col2(i), Len(Txt)) = Txt Then
Rows(i).Copy Sheets(2).Cells(65536, _
Col1.Column).End(xlUp).Offset(1, -Col1.Column + 1)
End If
Next
End If
Next count
MsgBox "finished"
[/VBA]

[blastpwr1970]

Thank's OBP you are good.

It works great.

Could it be too much to ask if all of this could it be done with a vlookup table because I have 1568 records.

All I had to change was Dim MyText As String andTxt = MyText to make it fully functional for my purpose.

Thank you

[OBP]

Julio, I am not quite sure what you are asking for, do you want to check all of the 1568 records for more than one instance of your Mytext instead of using the "Find" function.

[blastpwr1970]

Your code works great It is doing what it supouse to do, the only thing is that, I have way too many records to look at.

If I have to type all of these records one by one it will take me along time because I have to do it for several products.

The real problem is that I tried to do it with one product and VB wraps my input and won't allow me to enter so many records on one line of code.

alltext = "txt1,txt2,txt3,txt4.......txt200"
txt201,txt2002......txt300

My sheet is something like this

.....A
1 Txt1
2 Txt2
3 Txt3
4 Txt4
5 All the way to 200
6 Txt200

If I could just find the record of (A1) then (A2).... and enter it as Txt = MyText that would be great.

Thank you for all of your help in advance.

[OBP]

Julio, if you have the list of the "products" in your Excel Workbook the VB code can be modified to look up each one in turn and do your search.
Are you saying that your products are listed from A1 to A200?

[blastpwr1970]

Yes,
so the only way is to enter them directly in to the line of code.

[OBP]

Julio, no I will change the code to do it for you, but I am a bit confused at the moment.
Is it possible to post a copy of the workbook on here?
I am not sure what you are trying to do, if the part numbers are in Column A, isn't that the column that you are also searching?
If so why do you want to find all the Part Numbers, if you just want to work through all the parts you do not need to search for each one first.