Find Based on Cell Contents

Bench

Board Regular
Joined
Aug 27, 2009
Messages
134
I've been playing around with this rather excellent Find Function and the following sub. The sub kind of does what i want though it is too specific, basically i want to allow a user to put a figure into, say G1 then run the sub. This will search based upon what is in G1. Any idea how i modify it to do this?

Thanks

Rich (BB code):
Function Find_Range(Find_Item As Variant, _ Search_Range As Range, _ Optional LookIn As Variant, _ Optional LookAt As Variant, _ Optional MatchCase As Boolean) As Range​
Dim c As Range If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole If IsMissing(MatchCase) Then MatchCase = False
With Search_Range Set c = .Find( _ What:=Find_Item, _ LookIn:=LookIn, _ LookAt:=LookAt, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=MatchCase, _ SearchFormat:=False) If Not c Is Nothing Then Set Find_Range = c firstAddress = c.Address Do Set Find_Range = Union(Find_Range, c) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With
End Function



Sub Code:​

I've tried changing "ben" to G1 but this doesn't work, i tried G1 and "G1"




Rich (BB code):
Sub Ex_1()

 

Find_Range("ben", Range("B:B")).Select
Selection.Font.Bold = True​
End Sub​

 
Last edited:

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Alternatively and maybe even better, could i make it search dependant upon what was entered in a Prompt Box?
 
Upvote 0
Try

Code:
Sub Ex_1()
Find_Range(InputBox("what"), Range("B:B")).Font.Bold = True
End Sub
 
Upvote 0
Try

Code:
Sub Ex_1()
Find_Range(InputBox("what"), Range("B:B")).Font.Bold = True
End Sub

Hey thanks thats great, is there a way to make the search exact. For instance if i put in NG1, it will also find NG10, NG11, NG12 etc.

Thanks
 
Upvote 0
Try

Code:
Sub Ex_1()
Find_Range(InputBox("what"), Range("B:B"), , xlWhole).Font.Bold = True
End Sub
 
Upvote 0
Thanks, that worked a treat, sorry one last issue, i get a runtime error 91 if i search for something that isn't contained in the data range. I've tried a few error techniques but without success, i'm sure itll be simple. Ideally i'd like it so that if it can't find it it throws up a message box saying, not found would you like to search again, throwing the user back to the start if they choose yes, or ending the sub if they select no. Thanks in advance. really appreciate your help
 
Upvote 0
Sorry, managed to nail it, thanks for your help

Code:
Sub Ex_1()
    
    Application.ScreenUpdating = False

TryAgain:
    On Error GoTo NotFound
    
'   Clears Previous Results
    Rows("2:26").Select
    Selection.ClearContents
    Range("A1").Select
    
'   Input Box - Entry Point
    Find_Range(InputBox("Enter Postcode", "Postcode Finder"), Range("A:A")).EntireRow.Copy
    Range("Sheet1!A26").End(xlUp).Offset(1, 0).EntireRow.PasteSpecial
    Range("A1").Select
    Exit Sub
    
'   Error Handling
NotFound:
    Msg = "Sorry, No Matches, Try Again?"
    Ans = MsgBox(Msg, vbYesNo)
    If Ans = vbYes Then Resume TryAgain
End Sub

Also amended the Main Function to as follows, adding xlwhole in there.

Code:
Enum eLookin
    xlFormulas = -4123
    xlComments = -4144
    xlValues = -4163
End Enum
 
Enum eLookat
    xlPart = 2
    xlWhole = 1
End Enum
 
Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As eLookin, _
    Optional LookAt As eLookat, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range, FirstAddress As String
    If LookIn = 0 Then LookIn = xlValues
    If LookAt = 0 Then LookAt = xlWhole
    If IsMissing(MatchCase) Then MatchCase = False
     
    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False) 'Delete this term for XL2000 and earlier
        If Not c Is Nothing Then
            Set Find_Range = c
            FirstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
     
End Function
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,040
Members
448,543
Latest member
MartinLarkin

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
Back
Top