Excel VBA search engine code help


New Member
May 14, 2014

I'm trying to create a searchable knowledge database in Excel & having a bit of trouble editing some code i found to fit my requirements.

Basically I have a number of different worksheets representing different locations. They all have the same look and feel to them with rows of questions in column B and the corresponding answer in Column C.

I then have another worksheet called "Search". I want the user to enter a word/String in Cell B2, select the location from a drop down box in Cell B3, click a search button which runs a macro/some VBA code that displays all the results from Row 7 down with the question in column A and the answer is in Column B. Note I would like it so the word entered by the user is searched in both the question and answer columns and results displayed accodingly. (for example if the word "London" is in a question and also in another answer then the results will display both.

I have seen the following code which nearly gets what i want, is anybody able to provide some help how i modify this to make my requirement?

Many Thanks, code below..


Sub SearchParts()
 Dim arrParts() As Variant
    Range("A7", "B" & Cells(Rows.CountLarge, "B").End(xlDown).Row).Clear
    arrParts = FindParts(CStr(Trim(Cells(2, 2))))
    Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
End Sub

Private Function FindParts(PartNumber As String) As Variant
Dim ws As Worksheet
Dim FoundCell As Range
Dim LastCell As Range
Dim rngParts As Range
Dim FirstAddr As String
Dim arrPart() As Variant
    Set ws = Worksheets("Data")
    Set rngParts = ws.Range("A2:B" & ws.Cells(Rows.CountLarge, "B").End(xlUp).Row)
    With rngParts
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set FoundCell = rngParts.Find(What:=PartNumber, After:=LastCell, LookAt:=xlPart)
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If
    ReDim arrPart(1 To 2, 1 To 1)
    Do Until FoundCell Is Nothing
        arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
        arrPart(2, UBound(arrPart, 2)) = FoundCell.Value
        ReDim Preserve arrPart(1 To 2, 1 To UBound(arrPart, 2) + 1)
        Set FoundCell = rngParts.FindNext(After:=FoundCell)
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If
    FindParts = arrPart
End Function

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Hi there,

I'm not sure about the code you already have, but this is working for me:

Rich (BB code):
Sub Search()
    If Cells(6, 1) = "" Then Cells(6, 1) = "-"
    pg = CStr(Cells(3, 2))
    term = LCase(CStr(Cells(2, 2)))
    n = Sheets(pg).Cells(Rows.Count, 2).End(xlUp).Row
    For r = 1 To n
        If InStr(1, LCase(Sheets(pg).Cells(r, 2)), term) > 0 Or InStr(1, LCase(Sheets(pg).Cells(r, 3)), term) > 0 Then
            k = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(k, 1) = Sheets(pg).Cells(r, 2)
            Cells(k, 2) = Sheets(pg).Cells(r, 3)
        End If
    If Cells(6, 1) = "-" Then Cells(6, 1).ClearContents
End Sub
Note: The first and last lines (highlighted) are really there because I'm not sure if you have a heading or anything in A6 - if you do then you don't need those lines.

Hope this helps,

Last edited:
Upvote 0
Hi Simon,

Thanks, nearly works.

The issues i have with it compared to the other code is the following:

1. you press the button again and it appends the same resulting row underneath (i.e. the same question and answer - will repeat everytime you hit the button)
2. If i type something else in the search cell it appends underneath previous results rather than just displaying the results from the current search

Can you help fix?

Many Thanks
Upvote 0
Sorry I meant Chris! was confusing myself with emailing someone called Simon at work lol

Anyway i hope you have a solution to help me fix those last 2 issues, nearly there!

Many Thanks
Upvote 0
Ah, yes, I didn't consider that.


    Rows("7:" & Rows.Count).Delete
... to the start of the code should fix it.

Upvote 0
Perfect! Thanks very much!

Any other cool little features i can add to it to enhance it let me know

Upvote 0
sorry one last thing, everytime i hit the button it wipes out any formatting i've done. I want the Question & answer columns to be permanently horizontally Justified, do you have some additional code that can solve this?

Upvote 0

Forum statistics

Latest member

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