Solved: A short search and copy function

[gibbo1715]

ALL

I use the function below to search my data, what i would like to be able to do is find the shortest method possible of searching the sheet and then pasting the rows found into another sheet.

Thanks for looking

Gibbo

[VBA]Function fnFind(strFind, Optional sh) As Range

If IsMissing(sh) Then Set sh = ActiveSheet
On Error Resume Next
Set fnFind = sh.Cells.Find(What:=strFind, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

End Function

Sub TestfnFind()

Dim SearchFor As Range
Set SearchFor = fnFind(InputBox("What do you want to search for", "Search"))
If SearchFor Is Nothing Then
MsgBox ("Sorry Not Found")
Else
SearchFor.Select
End If

End Sub
[/VBA]

[gibbo1715]

All

I have taken a different approach to this and it seems to work remarkably quickly, What im doing is using a filter, see what you think about the code below, I d be really interested in your views

Gibbo

[VBA] Dim sChoice As String
Dim iLastRow As Long
Dim iLastColumn As Long
Dim rng As Range
Dim SteDetails As String
On Error GoTo ws_exit:
Application.EnableEvents = False
'Find Last Row
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Find Last Column
iLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
'Set Range from A1 to Last Row/Column
Set rng = Range("A1", Cells(iLastRow, iLastColumn))
'Call Filterandcopy to filter for contents of an Input Box
FilterAndCopy rng, InputBox("What do you want to search for?", "Search")
rng.AutoFilter
ws_exit:
Application.EnableEvents = True

End Sub
Sub FilterAndCopy(rng As Range, Choice As String)
'Clear Contents to show just new search data
Worksheets("Sheet2").Cells.ClearContents
'Set the column to filter (In This Case 1 or A)
rng.AutoFilter Field:=1, Criteria1:=Choice
'Copy Data across to sheet 2
rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Worksheets("Sheet2").Range("A1")
'Display Data
Worksheets("Sheet2").Select

End Sub [/VBA]

[mvidas]

Hi Gibbo,

I'm curious, why use:[vba] 'Find Last Row
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find Last Column
iLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
'Set Range from A1 to Last Row/Column
Set rng = Range("A1", Cells(iLastRow, iLastColumn))
'Call Filterandcopy to filter for contents of an Input Box[/vba]when you could just use[vba] Set rng = ActiveSheet.UsedRange[/vba]The only times I don't use that directly is when column A might not be used or row 1 might not be used, but as you're definately using them, you might as well just take the usedrange.
Your FilterAndCopy routine is good, I personally generally stay away from the autofilter for the most part, but it definately can be fast! The only thing I might do extra is changing[vba] 'Copy Data across to sheet 2
rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets("Sheet2").Range("A1")[/vba]to[ On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error GoTo 0
If Not FiltRng Is Nothing Then FiltRng.Copy Worksheets("Sheet2").Range("A1")[/vba]and adding[vba]Dim FiltRng As Range[/vba]to the top of the routine. This is just in case there are no visible cells (though your header row will probably always be visible), as that can cause the macro to error out.
Otherwise it looks good!
Matt

[gibbo1715]

Thanks Matt

So with those changes the code is as follows

[VBA] Sub Button1_Click()
Dim rng As Range
On Error GoTo ws_exit:
Application.EnableEvents = False
'Set Range
Set rng = ActiveSheet.UsedRange
'Call Filterandcopy to filter for contents of an Input Box
FilterAndCopy rng, InputBox("What do you want to search for?", "Search")
rng.AutoFilter
ws_exit:
Application.EnableEvents = True

End Sub
Function FilterAndCopy(rng As Range, Choice As String)
Dim FiltRng As Range
'Clear Contents to show just new search data
Worksheets("Sheet2").Cells.ClearContents
'Set the column to filter (In This Case 1 or A)
rng.AutoFilter Field:=1, Criteria1:=Choice
'Copy Data across to sheet 2
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error GoTo 0
If Not FiltRng Is Nothing Then FiltRng.Copy Worksheets("Sheet2").Range("A1")
'Display Data
Worksheets("Sheet2").Select
Range("A1").Select

End Function[/VBA]

[mvidas]

Looks good
If you're not going to filter anything but column A, I think you'd be hard-pressed to find a faster routine!

[gibbo1715]

Thanks Matt,

Do you think this will be suitable to put forward as a KB Entry then?

Cheers

Gibbo

[mvidas]

I don't see why not, assuming there isn't already one like this in there! I don't think there is though, but you may want to do a quick search just to be safe.
Matt

[Aaron Blood]

Have you ever looked at this one?

http://www.xl-logic.com/xl_files/vba...d_function.zip

I use it to do find/copy/paste actions (among other things) with a single line of code. The file includes lots of usage examples.

There was a time when it use to be listed here in the KB.

ALL

I use the function below to search my data, what i would like to be able to do is find the shortest method possible of searching the sheet and then pasting the rows found into another sheet.

Thanks for looking

Gibbo

[lucas]

Hi Gibbo,
looks good for a kb entry. Didn't find a simple seach and copy in the kb. Only problem I see is if you hit the cancel button on the inputbox.....and you have to have headers in sheet 1. attached is a sample of your code using a userform which gets around the cancel button problem with the inputbox.

[gibbo1715]

I always use row 1 as a header row anyway and im assuming because its using a filter to search thats why row one (i.e. the filter header) is always gonna be copied

Cheers

Gibbo

[Cass]

Have you ever looked at this one?

http://www.xl-logic.com/xl_files/vba...d_function.zip

I use it to do find/copy/paste actions (among other things) with a single line of code. The file includes lots of usage examples.

There was a time when it use to be listed here in the KB.

this is helpful file and examples but i want modify a little

[VBA]Set Found_Range = Find_Range(txt, Sheet4.Columns("F"), xlValues, xlPart).EntireRow[/VBA]
this range is whole row but i need only range("B#:G#")