Solved: Improve Find Function

[gibbo1715]

I have made a find function macro as below which searches a sheet and copies the results to another sheet,

What I am asking is if anyone has any suggestions on how to improve it,

Thanks Gibbo

[VBA] Sub TestFind()
Dim Data As String
Data = InputBox("What do you want to search for?", "Search")
If Data <> "" Then
Find Data, "Sheet2"
End If
End Sub
Function Find(StrSearch As String, StrSheet As String)
Dim Cell As Range, FirstAddress As String
Dim i As Long
On Error GoTo Err
'Clear Previous search contents if there
With Sheets("Sheet2")
.UsedRange.ClearContents
End With
'Select Range to search
With ActiveSheet.UsedRange
'Set Cell (Range) to find Search String
Set Cell = .Find(StrSearch, LookIn:=xlValues, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=True)
'Start Location
FirstAddress = Cell.Address
'Counter
i = 1
Do
'Copy to sheet 2 and add one to counter
Cell.EntireRow.Copy Worksheets(StrSheet).Range("A" & i)
i = i + 1
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End With
Err:
End Function
[/VBA]

[mvidas]

A couple things:
Use StrSheet instead of "Sheet 2" at the top of the function.
Also, i'd pass the function a worksheet object instead of a worksheet name.
You might also want to pass it a source sheet to search from instead of activesheet.

Personally, when I do what you're doing, I use a function I have called 'FoundRange' which returns a range of all the matches. Doesn't copy line by line, which should usually speed things up:[vba]Function FoundRange(ByVal vRG As Range, ByVal vVal) As Range
Dim FND As Range, FND1 As Range
Set FND = vRG.Find(vVal, LookIn:=xlValues, LookAt:=xlWhole)
If Not FND Is Nothing Then
Set FoundRange = FND
Set FND1 = FND
Set FND = vRG.FindNext(FND)
Do Until FND.Address = FND1.Address
Set FoundRange = Union(FoundRange, FND)
Set FND = vRG.FindNext(FND)
Loop
End If
End Function[/vba]
Use it like:[vba] Dim RG As Range
Set RG = FoundRange(Sheets("Sheet1").Columns("A"), "abc")
If Not RG Is Nothing Then
Sheets("Sheet2").Cells.ClearContents
RG.Copy Sheets("sheet2").Range("A1")
End If[/vba]allows you to specify the search area too. The more ways to customize where youre searching and where you're copying to, the better. It makes it a more useful function, in my opinion at least.
Matt

[gibbo1715]

Thanks for the advice, will have a bit of a play later,

If not a silly question with your code how would you get it to copy the row or part of it to the new sheet?

Gibbo

[mvidas]

Not a silly question. If you wanted to copy the entire row, you'd change the line in my sample sub to[vba] RG.EntireRow.Copy Sheets("sheet2").Range("A1")[/vba]As the Function returns a range object containing all the matches. You could loop through the returned range if you were searching xlPart and you wanted the whole cell's value, or use the .EntireRow to copy them all over
Matt

[gibbo1715]

Thanks Matt

Your method seems far better than mine so was wondering would there be any occation when my method would be considered a better approach,

cause I cant think of one at the moment.

Gibbo

[mvidas]

Yours would be more useful it there are a LOT of found cells, and they're not adjacent to another.
For example, put this formula in A1:A25000
=MOD(ROW(),2)

Then do a foundrange on "1". Since it will be every odd cell (a1,a3,a5,etc) that will probably too big for the Union method, and even if not, it would take a while to add each cell once it got too big. Thats when I'd go with something like yours, though when I encounter something like that I usually just build it in to the main sub instead of using a function for it (or I'll modify FoundRange for it).

[gibbo1715]

ok, had a play with both methods and your right about mine being a lot quicker with a large number of finds.

Well learning plenty as normal,

Thanks for the help

Gibbo

[mvidas]

Glad to help!