Hello
GOod day!
Can anyone help me on this.
I am new in excel, i just want to add criteria on my search form.
Here is the code of my workbook that i used.
1. SHEET 1 CODE
2.MODULE CODE
This is my excel workbook.
GOod day!
Can anyone help me on this.
I am new in excel, i just want to add criteria on my search form.
Here is the code of my workbook that i used.
1. SHEET 1 CODE
Code:
Private Sub CommandButton1_Click()
FindKeywords Me.txtSearch.Value
End SubCode:
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
DstWks.Cells(DSO(Result.Row), Result.Column).Interior.ColorIndex = 6
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("View")
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("View").Select
Range("a21").Select
End Sub