Search Engine in a User form

[nathandavies9]

Hi All, I had a thread on here a couple of weeks ago which a member was helping me with but he is no longer able to help me due to other commitments.

This is the thread was "Search Multiple Worksheets using a User form and display in list box."

I have tried myself to complete the code for the "search engine" tool but I don't have enough experience or knowledge to complete.

What I’m trying to create is a user form that allows me to search through a sheets which is selected using a combo-box, and then a column is selected again using a combo-box, then the user can search for a phrase in a text box. This will then display the rows which match the “phrase” in a list box.

The thought is that once the correct line is found, there will be a command button which will copy that row or multiple rows to a worksheet named “Order Rec”

There will also be list box in the user form which displays all the information in the worksheet “order rec” and if a row has been inputted by mistake you can remove a row using another command button…

If anyone can help it would be greatly appreciated.

Private Sub ComboBox2_Change()Dim Sh As Worksheet
Dim C As Range
Dim A As Long, B As Long


If ComboBox1.ListIndex <> -1 Then
    Me.ComboBox3.Clear
    Me.ListBox1.Clear
    Set Sh = Worksheets(CStr(Me.ComboBox1))
    
        With Sh
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            'find column to search
            For B = 1 To 4
                With .Range(.Cells(1, 1), .Cells(1, LastCol))
                    Set C = .Find(Me.ComboBox2, , xlValues)
                    If Not C Is Nothing Then
                        'Store Column number for later use.
                        Me.ComboBox3.Tag = Chr(64 + C.Column)
                        LastRow = Sh.Cells(Sh.Rows.Count, C.Column).End(xlUp).Row
                        With .Range(.Cells(1, C.Column), .Cells(LastRow, C.Row))
                            Set D = CreateObject("scripting.dictionary")
                                D.comparemode = 1
                                For A = 2 To LastRow
                                    If .Cells(A, C.Column) <> "" Then
                                        'Debug.Print .Cells(A, C.Column)
                                        If Not D.exists(.Cells(A, C.Column).Value) Then
                                            D.Add .Cells(A, C.Column).Value, Nothing
                                            Me.ComboBox3.AddItem .Cells(A, C.Column)
                                        End If
                                    End If
                                Next
                                D.RemoveAll
                        End With
                    End If
                End With
            Next
        End With
End If


End Sub


Private Sub ComboBox3_Change()
Dim Sh As Worksheet
Dim A As Long
Dim LastRow As Long
Dim C As Range
Dim D As Range
Dim ColLtr As String
Dim aCol As Long
Dim Headers As Variant


If Me.ComboBox3 <> "" Then
    
    Headers = Array("DESCRIPTION", "MANUFACTURER", "SUPPLIER", "PART NUMBER", "B&S PART NUMBER", "£ EACH")
    ColLtr = Me.ComboBox3.Tag
    
    Set Sh = Worksheets(CStr(Me.ComboBox1))
    
    With Sh
        LastRow = .Cells(.Rows.Count, ColLtr).End(xlUp).Row
        
        With Sh.Range(ColLtr & "1:" & ColLtr & LastRow)
            Set C = .Find(Me.ComboBox3, LookIn:=xlValues)
            If Not C Is Nothing Then
                firstAddress = C.Address
                Do
                    'DESCRIPTION, MANUFACTURER, SUPPLIER, PART NUMBER, B&S PART NUMBER, £ EACH
                    For A = 0 To UBound(Headers)
                        On Error Resume Next
                        aCol = Application.WorksheetFunction.Match(Headers(A), Sh.Rows(1), 0)
                        On Error GoTo 0
                        If aCol <> 0 Then
                            Select Case Headers(A)
                            Case "DESCRIPTION"
                                Me.ListBox1.AddItem Sh.Cells(C.Row, aCol)
                                Me.ListBox1.Column(6, Me.ListBox1.ListCount - 1) = C.Row
                            Case "MANUFACTURER"
                                Me.ListBox1.Column(1, Me.ListBox1.ListCount - 1) = Sh.Cells(C.Row, aCol)
                            Case "SUPPLIER"
                                Me.ListBox1.Column(2, Me.ListBox1.ListCount - 1) = Sh.Cells(C.Row, aCol)
                            Case "PART NUMBER"
                                Me.ListBox1.Column(3, Me.ListBox1.ListCount - 1) = Sh.Cells(C.Row, aCol)
                            Case "B&S PART NUMBER"
                                Me.ListBox1.Column(4, Me.ListBox1.ListCount - 1) = Sh.Cells(C.Row, aCol)
                            Case "£ EACH"
                                Me.ListBox1.Column(5, Me.ListBox1.ListCount - 1) = Sh.Cells(C.Row, aCol)
                            End Select
                            aCol = 0
                        End If
                    Next
                    Set C = .FindNext(C)
                Loop While Not C Is Nothing And C.Address <> firstAddress
            End If
        End With
    End With
End If
End Sub








Private Sub CommandButton1_Click()


End Sub


Private Sub Label11_Click()


End Sub


Private Sub ListBox1_Click()


End Sub


Private Sub UserForm_Activate()
Dim myshts, i As Integer


ComboBox1.Clear
ListBox1.ColumnWidths = "10,10,20,100,100,50,50,50,50"


myshts = ActiveWorkbook.Sheets.Count


For i = 1 To myshts


If ActiveWorkbook.Sheets(i).Name <> "Summary Sheet" Then ComboBox1.AddItem ActiveWorkbook.Sheets(i).Name


Next i
ComboBox1.ListIndex = 1


With Me.ListBox1
End With
End Sub


Sub temp()
Dim v, e


With Sheets("Events").Range("B1:B79")
    v = .Text
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .exists(e) Then .Add e, Nothing
    Next
    If .Count Then Me.ComboBox1.List = Application.Transpose(.keys)
End With
End Sub


SearchText
End Sub
Private Sub TextBox1_Change()
SearchText
End Sub
Private Sub TextBox2_Change()
SearchText
End Sub
Private Sub TextBox3_Change()
SearchText
End Sub


Private Sub SearchText()
Dim temp As Variant
Dim UniqueItem As Collection


Sheets(ComboBox1.Value).Select


temp = ActiveSheet.UsedRange.Address
TextLen = 0
Searchbox = 1


For Count = 1 To 3
If Len(Me.Controls("Textbox" & Count).Value) > TextLen Then
TextLen = Len(Me.Controls("Textbox" & Count).Value)
strValueToPick = Me.Controls("Textbox" & Count).Value
End If
Next


If TextLen < 3 Then Exit Sub


On Error Resume Next


    With Range(ActiveSheet.UsedRange.Address)
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If strFirstAddress = "" Then Exit Sub
    If Not rngPicked Is Nothing Then
        rngPicked.Select
    End If


ListBox1.Clear


Set UniqueItem = New Collection
    
'Find Matches
For Each C In Selection


RowText = Join(Application.Transpose(Application.Transpose(Range(Cells(C.Row, 1), Cells(C.Row, 6)).Value)), " ")
If Len(TextBox1.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox1.Text))) = 0 Then GoTo 10
If Len(TextBox2.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox2.Text))) = 0 Then GoTo 10
If Len(TextBox3.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox3.Text))) = 0 Then GoTo 10


On Error Resume Next


'Remove Duplicates


UniqueItem.Add CStr(C.Row), CStr(C.Row)
On Error GoTo 0


10 Next C


For N = 1 To UniqueItem.Count
          ListBox1.AddItem UniqueItem(N)
          
For Count = 1 To 6
          ListBox1.List(ListBox1.ListCount - 1, Count) = Cells(UniqueItem(N), Count)
Next
Next


End Sub