Well,

hello guys. I want to make this search engine code a little bit better. I have two main concerns:

1) If the user writes two or more words, e.g., sun moon the search engine will look for all the Data in column B with the word sun and/or moon. It means, instead of using the exactly word (sun moon) written in cells(2,2) it would search separately for each word.

2) This is far more important than the first one: I would like for similar words in the search engine. For example, if the user searches for sum it will return sun anyway, because the words are very similar. But the question is: what is similar? Well, I am asking for any help in a code that I don't have the slightest idea of how to do it.

Thank you very much, in my next post I will have studied more about VBA.

Sub SearchParts()
 Dim arrParts() As Variant
    Range("A7", "D" & Cells(Rows.CountLarge, "D").End(xlDown).Row).Clear
    arrParts = FindParts(CStr(Trim(Cells(2, 2))))
    Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
        WorksheetFunction.Transpose(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("B4: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 4, 1 To 1)
    Do Until FoundCell Is Nothing
        arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
        arrPart(2, UBound(arrPart, 2)) = FoundCell.Value
        arrPart(3, UBound(arrPart, 2)) = FoundCell.Offset(0, 1)
        arrPart(4, UBound(arrPart, 2)) = FoundCell.Offset(0, 2)
        
        ReDim Preserve arrPart(1 To 4, 1 To UBound(arrPart, 2) + 1)

        Set FoundCell = rngParts.FindNext(After:=FoundCell)
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
    FindParts = arrPart
End Function