Userform search (if Possible)

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • sandy armstrong
    New Member
    • Oct 2011
    • 88

    Userform search (if Possible)

    I was wondering if anyone can please help me with this task I would to create a userform that will search a workbook in excel with mulitiple sheet, it could be 5-endless worksheets The way i would like to do this is a new tab is created when a new client is add to our database and be able to seach curtain critiera such Hospital name, Contact name,services,p hone numbers(if possible)and User name (if Possible) It sounds more complacted then it seems i am going to try to attach the file and code is there anyone whom can help i will be thankful


    Code:
    [Option Explicit]
    
    'Module Level Variables
    Dim rRange As Range
    Dim strFind1 As String
    Dim strFind2 As String
    Dim strFind3 As String
    
    
    Private Sub ComboBox1_Change()
    'Pass chosen value to String variable strFind1
    strFind1 = ComboBox1
    'Enable ComboBox2 only if value is chosen
    ComboBox2.Enabled = Not strFind1 = vbNullString
    End Sub
    Private Sub ComboBox2_Change()
    'Pass chosen value to String variable strFind1
    strFind2 = ComboBox2
    'Enable ComboBox3 only if value is chosen
    End Sub
    
    
    Private Sub CommandButton1_Click()
    'Procedure level variables
    Dim lCount As Long
    Dim lOccur As Long
    Dim rCell As Range
    Dim rCell2 As Range
    Dim rCell3 As Range
    Dim bFound As Boolean
    
    'At least one value, from ComboBox1 must be chosen
    If strFind1 & strFind2 & strFind3 = vbNullString Then
       MsgBox "No items to find chosen", vbCritical
       Exit Sub 'Go no further
    ElseIf strFind1 = vbNullString Then
       MsgBox "A value from " & Label1.Caption _
       & " must be chosen", vbCritical
       Exit Sub 'Go no further
    End If
    
    'Clear any old entries
    On Error Resume Next
    ListBox1.Clear
    On Error GoTo 0
    
    'If String variable are empty pass the wildcard character
    If strFind2 = vbNullString Then strFind2 = "*"
    If strFind3 = vbNullString Then strFind3 = "*"
    
    'Set range variable to first cell in table.
    Set rCell = rRange.Cells(1, 1)
    'Pass the number of times strFind1 occurs
    lOccur = WorksheetFunction.CountIf(rRange.Columns(1), strFind1)
    
    'Loop only as many times as strFind1 occurs
    For lCount = 1 To lOccur
    'Set the range variable to the found cell. This is then also _
     used to start the next Find from (After:=rCell)
        Set rCell = rRange.Columns(1).Find(What:=strFind1, After:=rCell, _
                  LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                  SearchDirection:=xlNext, MatchCase:=False)
        'Check each find to see if strFind2 and strFind3 occur _
         on the same row.
        If rCell(1, 2) Like strFind2 And rCell(1, 3) Like strFind3 Then
           bFound = True 'Used to not show message box for no value found.
           'Add the address of the found cell and the cell on the _
            same row but 2 columns to the right.
           ListBox1.AddItem rCell.Address & ":" & rCell(1, 3).Address
        End If
    Next lCount
    
    If bFound = False Then 'No match
     MsgBox "Sorry, no matches", vbOKOnly
    End If
    End Sub
    
    Private Sub CommandButton2_Click()
    'Close UserForm
    Unload Me
    End Sub
    
    
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    'Check for range addresses
    If ListBox1.ListCount = 0 Then Exit Sub
    'GoTo doubled clicked address
    Application.Goto Range(ListBox1.Text), True
    End Sub
    
    Private Sub UserForm_Initialize()
    'Procedure level module
    Dim lRows As Long
    
    'Set Module level range variable to CurrentRegion _
     of the Selection
    Set rRange = Selection.CurrentRegion
        If rRange.Rows.Count < 2 Then ' Only 1 row
           MsgBox "Please select any cell in your table first", vbCritical
           Unload Me 'Close Userform
           Exit Sub
        Else
    
        With rRange
        'Set Label Captions to the Table headings
            Label1.Caption = .Cells(1, 1)
            Label2.Caption = .Cells(1, 2)
            Label3.Caption = .Cells(1, 3)
            
            'Set RowSource of ComboBoxes to the appropriate columns _
             inside the table
           strSheet = ListBox1.List(ListBox1.ListIndex, 1)
        strAddress = ListBox1.List(ListBox1.ListIndex, 2)
            
            
        End With
        End If
    End Sub
    
    Private Sub UserForm_Terminate()
    'Destroy Module level variables
    Set rRange = Nothing
    strFind1 = vbNullString
    strFind2 = vbNullString
    End Sub
    update:
    By the way the Log-n password is PLS4-Username Password PLS
    Attached Files
    Last edited by Niheel; Oct 12 '11, 08:14 PM.
  • Guido Geurs
    Recognized Expert Contributor
    • Oct 2009
    • 767

    #2
    Is this Office 2003?
    In the ZIP is an .LNK file and not a .XLS or a .XLSM!

    Comment

    • sandy armstrong
      New Member
      • Oct 2011
      • 88

      #3
      I am very new to this here is a new copy of what i need help with
      Attached Files

      Comment

      • Guido Geurs
        Recognized Expert Contributor
        • Oct 2009
        • 767

        #4
        This is still a LINK to a database we don't have.
        Is it possible to put some data in an Excel file and attach this file in Bytes ? (also with you form)
        Because in your code there is no connection to a database, is your data already in the Excel workbook ?
        Or am I wrong ?

        Comment

        • sandy armstrong
          New Member
          • Oct 2011
          • 88

          #5
          This is the very beginging stages of what i am trying to accomplish I did not realize until now that if I make a change in my workbook it will also change what i posted on Bytes can i please have an email for you in order for me to forward this file to you, i cant seem to upload this correctly.
          Or if you can tell me another way of getting this to you i really need help!!! and would be thankful for any guidedance in this matter.

          Comment

          • Guido Geurs
            Recognized Expert Contributor
            • Oct 2009
            • 767

            #6
            Is it possible to send us an Excel file with some data (+- 100 rows of data in some sheets) (the file can't be to big !!) in a ZIP file ?
            I have attached a DOC and a PDF explaining how to do this.
            Attached Files

            Comment

            Working...