Find keyword using multiple Text box and combox value

[Ryan_Bernal]

Hello Guys!.
I am here again.
Need help in query form using text box value.
I have database and a search form and i need to display only the results based on queries (text box value).


Private Sub CommandButton1_Click()
FindKeywords Me.txtNo.Value & Me.txtName.Value & Me.txtParts.Value
End Sub


Module


Public DSO As Object
Public DstRow As Long
Public DstWks As Worksheet

Private Sub FindKeyword(ByVal Keyword As String, ByRef SrcWks As Worksheet)

Dim LastRow As Long
Dim Result As Range
Dim Rng As Range
Dim StartRow As Long

StartRow = 2
LastRow = SrcWks.Cells(Rows.Count, "B").End(xlUp).Row
LastRow = IIf(LastRow < StartRow, StartRow, LastRow)

Set Rng = SrcWks.Cells(1, 1).CurrentRegion.Offset(1, 0)
Set Rng = Rng.Resize(Rng.Rows.Count - 1)

Set Result = Rng.Find(what:=Keyword, _
After:=Rng.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
A = Rng.Address
If Not Result Is Nothing Then
FirstAddx = Result.Address
Do
If Not DSO.Exists(Result.Row) Then
DSO.Add Result.Row, DstRow
SrcWks.Rows(Result.Row).EntireRow.Copy Destination:=DstWks.Cells(DstRow, "A")
DstRow = DstRow + 1
End If
Set Result = Rng.FindNext(Result)
Loop While Not Result Is Nothing And Result.Address <> FirstAddx
End If

End Sub

Public Sub FindKeywords(ByVal Keywords As String)

Dim Keys As String
Dim Keyword As Variant
Dim Sht As Worksheet
Dim i As Long
Dim Idx As Long

Idx = Sheet1.cmbSearchName.ListIndex
If Idx = -1 Then
MsgBox "Select database sheet", vbInformation
Exit Sub
End If


Set DstWks = Worksheets("Main")
Set Sht = Worksheets(CStr(Sheet1.cmbSearchName.List(Idx)))

If DSO Is Nothing Then
Set DSO = CreateObject("Scripting.Dictionary")
DSO.Comparemode = vbTextCompare
Else
DSO.RemoveAll
End If

If Len(Keywords) Then
DstRow = 21
DstWks.UsedRange.Offset(20, 0).Clear
Keyword = Split(Keywords, ",", Compare:=vbTextCompare)
For i = 0 To UBound(Keyword)
FindKeyword Keyword(i), Sht
Next
Else
Exit Sub
End If

Set DSO = Nothing
Sheets("Main").Select
Range("a21").Select

End Sub




Here is my WorkBook. Thanks in advance!

[Excel Fox]

Try this...


Private Sub CommandButton1_Click()
Dim varCriteria As Variant
Dim varIndex As Variant
Dim lngElements As Long

lngElements = Abs(Me.txtNo.Value <> "") + Abs(Me.txtName.Value <> "") + Abs(Me.txtParts.Value <> "")
ReDim varCriteria(1 To lngElements)
ReDim varIndex(1 To lngElements)
lngElements = 0
If Me.txtNo.Value <> "" Then
lngElements = lngElements + 1
varCriteria(lngElements) = Me.txtNo.Value
varIndex(lngElements) = 1
End If

If Me.txtName.Value <> "" Then
lngElements = lngElements + 1
varCriteria(lngElements) = Me.txtName.Value
varIndex(lngElements) = 2

End If
If Me.txtParts.Value <> "" Then
lngElements = lngElements + 1
varCriteria(lngElements) = Me.txtParts.Value
varIndex(lngElements) = 3
End If
Consolidator varCriteria, varIndex, Worksheets(Me.cmbSearchName.Value)
End Sub
Function Consolidator(varCriteria As Variant, varIndex As Variant, wks As Worksheet)
Dim varSource As Variant
Dim lngElements As Long
Dim lngRows As Long
Dim blnValid As Boolean
Dim varOutput As Variant
Dim lngCounter As Long

With wks
varSource = .Range("B4:G" & .Cells(Rows.Count, 2).End(xlUp).Row)
End With
ReDim varOutput(1 To UBound(varSource), 1 To UBound(varSource, 2))
For lngRows = LBound(varSource) To UBound(varSource)
For lngElements = LBound(varCriteria) To UBound(varCriteria)
If UCase(varSource(lngRows, varIndex(lngElements))) = UCase(varCriteria(lngElements)) Then
blnValid = True
Else
blnValid = False
Exit For
End If
Next lngElements
If blnValid Then
lngCounter = lngCounter + 1
For lngElements = 1 To UBound(varSource, 2)
varOutput(lngCounter, lngElements) = varSource(lngRows, lngElements)
Next lngElements
End If
Next lngRows
With Worksheets("Main")
.Range("B21:G" & .Cells(Rows.Count, 2).End(xlUp).Row + 2).ClearContents
.Range("B21").Resize(UBound(varOutput), UBound(varOutput, 2)).Value = varOutput
End With

End Function

[Ryan_Bernal]

Thank you so much admin.
It works like a magic!