Results 1 to 3 of 3

Thread: Find keyword using multiple Text box and combox value

  1. #1
    Member Ryan_Bernal's Avatar
    Join Date
    Dec 2012
    Posts
    37
    Rep Power
    0

    Find keyword using multiple Text box and combox value

    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!
    Attached Files Attached Files

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    Try this...

    Code:
    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
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  3. #3
    Member Ryan_Bernal's Avatar
    Join Date
    Dec 2012
    Posts
    37
    Rep Power
    0
    Thank you so much admin.
    It works like a magic!
    Last edited by Ryan_Bernal; 03-07-2013 at 06:50 PM.

Similar Threads

  1. Replies: 3
    Last Post: 06-01-2013, 11:31 AM
  2. Linking a table to a text box
    By Safal Shrestha in forum Excel Help
    Replies: 6
    Last Post: 04-25-2013, 10:37 AM
  3. Find a text substring that matches a given "pattern"
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 2
    Last Post: 02-10-2013, 06:19 AM
  4. Replies: 2
    Last Post: 09-25-2012, 01:30 AM
  5. Find the First or Last So Many Words in a Text String
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 6
    Last Post: 06-21-2012, 09:42 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •