VBA – Generate custom search engine with Excel

Posted on January 5, 2015 by

MS Excel has a pretty good search option – you have probably used the Ctrl+F option a lot. Anyway, in the current article I will show you how to generate your own Search Engine. Why would you need it? Because it is way more customizable, than the standard! 🙂 And it looks fancier. In the current example, the search box would search all values, disregarding the spaces in front and in the back in both the searched string and the array with strings. Furthermore, it would disregard the upper and the lower case.

E.g. if you type “LoWerCase ” it would be able to match ” lowercase “. That is somehow really useful, if you have to build an Excel Application with data, entered from the user. At the end, the cell with the contained value is highlighted and its address appears in a message box. What more for less than 30 lines of code? Here is the way it looks:

Here comes the code:

Option Explicit

Sub FindWhat()

    Dim rObject         As Range
    Dim lObjectR        As Long
    Dim lObjectC        As Long
    Dim sFindWhat       As String
    Dim rCell           As Range
    
    sFindWhat = InputBox("Type a record to find", ActiveSheet.Name)
    Cells.Borders.Color = vbWhite
        
    For Each rCell In ActiveSheet.UsedRange
    
        If UCase(Trim(rCell.Text)) = UCase(Trim(sFindWhat)) Then
            Set rObject = rCell
            Exit For
        End If
        
        Debug.Print rCell.Address
        
    Next rCell
    

    If rObject Is Nothing Then
        MsgBox sFindWhat & " was not found.", vbInformation, ActiveSheet.Name
        Exit Sub
    Else
        lObjectR = rObject.Row
        lObjectC = rObject.Column
        MsgBox sFindWhat & " was found in cell " & Cells(lObjectR, lObjectC).Address & "."
        rObject.Borders.Color = vbRed
    End If
    
    Set rObject = Nothing

End Sub

Option Explicit

Sub FindWhat()

Dim rObject As Range

Dim lObjectR As Long

Dim lObjectC As Long

Dim sFindWhat As String

Dim rCell As Range

sFindWhat = InputBox("Type a record to find", ActiveSheet.Name)

Cells.Borders.Color = vbWhite

For Each rCell In ActiveSheet.UsedRange

If UCase(Trim(rCell.Text)) = UCase(Trim(sFindWhat)) Then

Set rObject = rCell

Exit For

End If

Debug.Print rCell.Address

Next rCell

If rObject Is Nothing Then

MsgBox sFindWhat & " was not found.", vbInformation, ActiveSheet.Name

Exit Sub

Else

lObjectR = rObject.Row

lObjectC = rObject.Column

MsgBox sFindWhat & " was found in cell " & Cells(lObjectR, lObjectC).Address & "."

rObject.Borders.Color = vbRed

End If

Set rObject = Nothing

End Sub

Enjoy it! 🙂