Help with Excel 'find' please

Hi there,

Please can someone help me or point me in the right direction.

I'm trying to limit the search routine, below, to only find values from one column,
D for example. At the moment it will find values from the whole sheet.

I need to limit the 'find' because I want to take the routine one stage further.
At present, because of the way it works, I get values I don't want, well would
prefer not to have atleast.

I've tried to limit the find a number of ways but haven't had any success.

Thanks in advance,

Nick
[vba] Sub FindCodesV2()
Dim rng1 As Range
Dim cel1 As Range
Dim counter As Integer
counter = 2

Set rng1 = Worksheets("Sheet1").Range("A2:A57")

For Each cel1 In rng1

cellValue = Cells.find(What:=cel1.Value, After:=cel1, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Worksheets("Sheet1").Cells(counter, 2).Value = ActiveCell
counter = counter + 1
Next cel1
End Sub
[/vba]

Hi Nick,

you need to apply the Find method to a particular range - at the moment you're using "Cells" (all of them), so to specify column D[VBA]For Each cel1 In rng1
Set cellValue = Columns(4).Find(What:=cel1.Value, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

Worksheets("Sheet1").Cells(counter, 2).Value = ActiveCell
counter = counter + 1
Next cel1[/VBA]

Thanks for the help Killian.

I've put your code into the macro, however now when I run it I get the
first value found, i.e. the value from cell D1, pasted into all the other cells.

Any ideas,

Thanks

Nick

P.S. Having looked a bit further, it appears to be using the value from the cell I have
highlighted when I run the script.

Hi Nick,

this is bacause you previuosly activated the cell and you're using [VBA]Worksheets("Sheet1").Cells(counter, 2).Value = ActiveCell[/VBA]
You can use the cellValue directly rather than accessing this.
Equally, you can use the cel1.Row value rather than a counter[VBA]Sub FindCodesV2()
Dim rng1 As Range
Dim cel1 As Range
Dim cellValue As Range

Set rng1 = Worksheets("Sheet1").Range("A2:A57")
For Each cel1 In rng1
Set cellValue = Columns(4).Find(What:=cel1.Value, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

If Not cellValue Is Nothing Then
Worksheets("Sheet1").Cells(cel1.Row, 2).Value = cellValue.Value
End If
Next cel1
End Sub[/VBA]

Hi,

This is sort of on the same lines of a problem I have been trying to get to grips with yesterday and today. I have been trying to make a search routine which searches for multiple instances of a text string in column A in multiple sheets (over 100) and copies the entire row for each result found into the output sheet where the search button is located.

So I was wondering if this routine could be tweaked to meet the above criteria?

So far I have been trying to merge 2 macro's from forums which nearly do what I need but without success.

Any thoughts appreciated

Shaolin

Hi Killian,

Sorry for the delay with my reply. Thanks for the explanation, it did the trick.

After some playing around I ended up with this:-
[vba]Sub FindCodesV3()
'
'multiple entries version
'
Dim rng1 As Range
Dim cel1 As Range
Dim counter As Integer
counter = 2
Set rng1 = Worksheets("Image Names").Range("A2:A101")

For Each cel1 In rng1

If cel1.Value <> "0" Then

With Worksheets(3).Range("d2:d2001") 'CHANGE THE 'Worksheets(3)'

Set c = Columns("D").Find(What:=cel1.Value, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

If Not c Is Nothing Then

firstAddress = c.Address
'MsgBox "firstAddress = " & firstAddress

Worksheets("Image Names").Cells(counter, 2).Value = c

Set c = .FindNext(c)
secondAddress = c.Address
'MsgBox "secondAddress = " & secondAddress


If secondAddress <> firstAddress Then
Worksheets("Image Names").Cells(counter, 3).Value = c
End If

Else
Worksheets("Image Names").Cells(counter, 2).Value = "0"
End If

End With

End If

counter = counter + 1

Next cel1

End Sub[/vba]

It works fine and fills the required columns with the relevant search data. I'm going to take it further so the search range values are picked up from cells on the worksheet.

I'd appreciate any help on tidying up the code if possible, not sure if this is the best way to have done this task.

Thanks again,

Nick

Hi Shaolin,

I've posted the final routine, not sure if this will help you any?

From a list of 4 digit codes, in Column A, it searches for each code in a picture list in Column D.
If any instances are found the entry from column D is put into Column B alongside the 4 digit code.
A check is done to see if there is a second instance, if there is, this is put in to
Column C in the relevant position.

Hopefully you may be able to utilize something from it.

I found the articles below useful.

http://www.techonthenet.com/excel/macros/copy_data2.php

http://www.techonthenet.com/excel/macros/copy_data3.php

http://www.techonthenet.com/excel/macros/copy_data4.php

Regards

Nick

Hi Nick,

Glad you got it working.
I would suggest a couple of alternatives:
1) you don't need to keep track of which row you are in with a counter since you are using "For each cel1 in...", so "cel1.Row" will give you your current row number.
However, the counter could be used for counting how many results you have for each "cel1" found and using it as a column offset to return not just a second result but as many as there are (until you run out of columns to put them in, that is)

2) multiple finds are usually done with a Do...While loop. The principle being that you execute you first "Find" and save it's address, just as you did, then loop the "FindNext" while two conditions are met:
the FindNext returns a result - "Not c Is Nothing", and
you haven't looped back to the first result - "c.Address <> firstAddress"

It all looks like this:[VBA]Sub FindCodes()

Dim rngToSearch As Range
Dim cel1 As Range
Dim c As Range
Dim counter As Integer
Dim firstAddress As String

Set rngToSearch = Worksheets(3).Range("d2:d2001")

For Each cel1 In Worksheets("Image Names").Range("A2:A101")
'counter holds the number of successful finds for each cel1
'used as a column index offset when adding the result to Worksheets("Image Names")
counter = 1
If cel1.Value <> "0" Then
Set c = rngToSearch.Find(What:=cel1.Value, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets("Image Names").Cells(cel1.Row, cel1.Column + counter).Value = c
counter = counter + 1
'check for the column limit
If counter = ActiveSheet.Columns.Count Then Exit Do
Set c = rngToSearch.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
Next cel1

End Sub[/VBA]

Hi Shaolin,

To extend the code I posted above to work across all the worksheets in the workbook, the main part can just be wrapped in another For... Each... Next loop (excluding the sheets not to be processed).
Because you're copying the whole row across, the counter can be modified to keep track of the number of results overall and used as the output sheet row index [VBA]Sub FindCodes()

Dim rngToSearch As Range
Dim cel1 As Range
Dim c As Range
Dim counter As Integer
Dim firstAddress As String
Dim ws As Worksheet

counter = 1 'start output in row 1
For Each cel1 In Worksheets("Text Strings").Range("A2:A6")
If cel1.Value <> "" Then
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Text Strings" And ws.Name <> "Output Sheet" Then
Set rngToSearch = ws.Columns(1)
Set c = rngToSearch.Find(What:=cel1.Value, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy Worksheets("Output Sheet").Rows(counter)
counter = counter + 1
Set c = rngToSearch.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
Next ws
End If
Next cel1

End Sub[/VBA]

thats a nice one Killian....kb material?

Hi Killian,

Thanks for the comments and help, it's useful to see a cleaner way of working.
I'll have a look at some of the other macros I have.

I like the use of the counter as a column offset, that may come in useful as the version
I'd done only works for two instances which was initially all I required.

Thanks again,

Nick

Hi Killian,

Once again, thanks again for the help with the code.

Yesterday I finally had chance to have a play with it.
I did find a couple of things that I needed to tweak.
The first one being this line [vba]If cel1.Value <> "" Then '"0"[/vba]
I found that if the I left the value as 0 this would cause a problem if the cell
containing the four digit code did't have anything in it.For some reason I got a delay.
I think this was because if no value had been found the search would then repeat over itself looking for nothing.
This loop would go on to the end of the work sheet because of this[vba]If counter = ActiveSheet.Columns.Count Then Exit Do[/vba]

I also added the next bit of code to insert a value if nothing was returned by the search.[vba]Else
Worksheets(1).Cells(cel1.Row, cel1.Column + counter).Value = "0"
End If[/vba]

I also had to shuffle the columns around, due to the way the columns were laid out
some of the 'filelist' was being wiped out by the search results.

If I've read the code wrong regarding 'find' loop would you let me know please,
being a newbie I could have got it all wrong, thanks.

Regards,

Nick

P.S. Here's the final code:-

[VBA]Sub FindCodesV4_2()

Dim rngToSearch As Range
Dim cel1 As Range
Dim c As Range
Dim counter As Integer
Dim firstAddress As String

Dim codeListRange As String
codeListRange = "B" & Range("A12").Value & ":B" & Range("A14").Value
MsgBox "Cell range = " & codeListRange

Set rngToSearch = Worksheets(1).Range("D2:D2001")
For Each cel1 In Worksheets(1).Range(codeListRange)
'counter holds the number of successful finds for each cel1
'used as a column index offset when adding the result to Worksheets("Image Names")
counter = 3
If cel1.Value <> "" Then
Set c = rngToSearch.find(What:=cel1.Value, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets(1).Cells(cel1.Row, cel1.Column + counter).Value = c
counter = counter + 1

'check for the column limit
If counter = ActiveSheet.Columns.Count Then Exit Do
Set c = rngToSearch.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
Else
Worksheets(1).Cells(cel1.Row, cel1.Column + counter).Value = "0"
End If
End If
Next cel1

Range("A16").Select

End Sub[/VBA]

Hi Nick,

I think you've got that about right. Funnily enough, I changed to "" in the post for Shaolin but left as "0" in yours.

Glad its working out