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).
Code:
Private Sub CommandButton1_Click()
FindKeywords Me.txtNo.Value & Me.txtName.Value & Me.txtParts.Value
End Sub
Module
Code:
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!
Bookmarks