Find Based on Cell Contents

[Bench]

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

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"​

Sub Ex_1()

 

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

End Sub​

​

 

[Bench]

Alternatively and maybe even better, could i make it search dependant upon what was entered in a Prompt Box?

 

[VoG]

Try

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

 

[Bench]

Try

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

 

[VoG]

Try

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

 

[Bench]

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

 

[Bench]

Sorry, managed to nail it, thanks for your help

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.

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