Creating a custom search function

doumamar

New Member
Joined
Jul 15, 2010
Messages
41
Hi,

I have a userform and would like to create a search function on it.
I would like it to check a dynamic range of cells on a single worksheet for an expression the user enters into the search box.
I would then like all rows in which the expression is found to be copied onto a separate sheet.

I have searched for a while for an idea on how to do this, but alas I am new to VBA and have little clue as to how to complete such a task.

Does anyone know how to do this?

Thanks
David
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

AgentSmith

Well-known Member
Joined
Mar 8, 2004
Messages
575
Re this "dynamic range", what determines the cells you wish to search? Is it a named range or is something on the form that tells it where to search?

Something like this might do it:
Code:
Public Sub SearchAndCopy(SearchFor As String, SearchRange As Range)
    Dim CurrRow As Long     'the row on which the current match is found
    Dim PrevRow As Long     'the row on which the last match was found (<> CurrRow)
    Dim PasteRow As Long    'the row number to paste to
    Dim FoundCell As Range  'result of the Find()
    Dim FirstAddress As String
    
    'Initialise
    PasteRow = 2
    PrevRow = -1
    
    'Search for matches then copy and paste rows to Sheet2
    Application.Goto SearchRange.Cells(1, 1)
    Set FoundCell = SearchRange.Find(SearchFor, , xlFormulas, xlPart, xlNext)
    If Not FoundCell Is Nothing Then
        FirstAddress = FoundCell.Address
        Do
            CurrRow = FoundCell.Row
            If CurrRow <> PrevRow Then
                SearchRange.Rows(CurrRow).EntireRow.Copy 'drop .EntireRow if you don't need it
                Worksheets("Sheet2").Activate
                Cells(PasteRow, 1).Activate
                ActiveSheet.Paste
                PasteRow = PasteRow + 1
                PrevRow = CurrRow
            End If
            Set FoundCell = SearchRange.FindNext(FoundCell)
        Loop Until FoundCell Is Nothing Or FoundCell.Address = FirstAddress
        Application.CutCopyMode = False
    End If
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,955
Messages
5,599,040
Members
414,280
Latest member
morralletti

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top