Attend Excelapalooza
Page 1 of 2 12 LastLast
Results 1 to 10 of 16

Thread: Searching within a cell for ANY match.

  1. #1
    New Member
    Join Date
    May 2018
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Searching within a cell for ANY match.

    I have a script that searches for data using a userform, it's working great except for one thing - I would like to search anything within the cell and not search from an exact match like it's currently doing.

    For example -

    One of my entries is "BEHAVIOR HEALTH SPECIALIST ASST (BHSA)"

    Currently I can only get this to come up if I type Behavior. I would like this entry to come up if I type SPECIALIST or if I type ASST or if I type BHSA....

    How can I get this to work the way I need?

    Thanks for your assistance.

    Code:
    Private Sub cmdPrint_Click()
    
    Sheet1.Select
    Sheet1.Range("outdata").Select
    Sheet1.PageSetup.PrintArea = "outdata"
    Application.Dialogs(xlDialogPrint).Show
    
    
    End Sub
    
    
    Private Sub CommandButton1_Click()
    AdminPhoneList.Show
    End Sub
    
    
    Private Sub cmdListAll_Click()
    cmdClear_Click
    cmdContact_Click
    End Sub
    
    
    
    
    Private Sub UserForm_Initialize()
    Me.cboSelect.List = WorksheetFunction.Transpose(Sheet1.Range("B8:K8"))
    
    
    End Sub
    
    
    Private Sub cboSelect_Change()
    
    
    End Sub
    
    
    Private Sub cboSelect_Enter()
    ListBox1.RowSource = ""
    End Sub
    
    
    Private Sub cmdAdd_Click()
    Set Drng = Sheet1.Range("B8")
    'move the values without selecting
    Drng.End(xlDown).Offset(1, 0).Value = Me.txtName.Value
    Drng.End(xlDown).Offset(0, 1).Value = Me.txtExtension.Value
    Drng.End(xlDown).Offset(0, 2).Value = Me.txtDepartment.Value
    Drng.End(xlDown).Offset(0, 3).Value = Me.txtTitle.Value
    Drng.End(xlDown).Offset(0, 4).Value = Me.txtUnit.Value
    Drng.End(xlDown).Offset(0, 5).Value = Me.txtBuilding.Value
    Drng.End(xlDown).Offset(0, 6).Value = Me.txtRoom.Value
    Drng.End(xlDown).Offset(0, 7).Value = Me.txtShift.Value
    Drng.End(xlDown).Offset(0, 8).Value = Me.txtSupervisor.Value
    Drng.End(xlDown).Offset(0, 9).Value = Drng.End(xlDown).Offset(-1, 9).Value + 1
    SortIt
    End Sub
    
    
    Private Sub cmdClose_Click()
    Unload Me
    End Sub
    
    
    Private Sub cmdContact_Click()
            On Error GoTo errHandler:
            Set DataSH = Sheet1
                DataSH.Range("O8") = Me.cboSelect.Value
                DataSH.Range("O9") = Me.txtSearch.Text
                DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                    "phonelist!Criteria"), CopyToRange:=Range("phonelist!Extract"), Unique:= _
                    False
                    ListBox1.RowSource = Sheet1.Range("outdata").Address(external:=True)
    
    
    Exit Sub
    errHandler:
    MsgBox "There was an error"
    End Sub
    
    
    Private Sub cmdDelete_Click()
    On Error GoTo cmdDelete_Click_Error
    If txtName = "" Then
    Call MsgBox("Double click the contact so it can be deleted", vbInformation, "Delete Contact")
    Exit Sub
    End If
    
    
    Select Case MsgBox("You are about to delete a contact." _
    & vbCrLf & "Do you want to proceed?" _
    , vbYesNo Or vbQuestion Or vbDefaultButton1, "Are you sure about this")
    Case vbYes
    Case vbNo
    Exit Sub
    End Select
    
    
    'Sheet1.Range("a1") = txtID.Value
    Set findvalue = Sheet1.Range("K8:K10000").Find(What:=Me.txtID, LookIn:=xlValues)
    findvalue.Value = ""
    findvalue.Offset(0, -1).Value = ""
    findvalue.Offset(0, -2).Value = ""
    findvalue.Offset(0, -3).Value = ""
    findvalue.Offset(0, -4).Value = ""
    findvalue.Offset(0, -5).Value = ""
    findvalue.Offset(0, -6).Value = ""
    findvalue.Offset(0, -7).Value = ""
    findvalue.Offset(0, -8).Value = ""
    findvalue.Offset(0, -9).Value = ""
    ClearList
    SortIt
    On Error GoTo 0
    Exit Sub
    'if error occurs then show me exactly where the error occurs
    cmdDelete_Click_Error:
    
    
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdDelete_Click of Form PhoneList"
    End Sub
    
    
    Sub ClearList()
    
    
    Me.txtName.Value = ""
    Me.txtExtension.Value = ""
    Me.txtDepartment.Value = ""
    Me.txtTitle.Value = ""
    Me.txtUnit.Value = ""
    Me.txtBuilding.Value = ""
    Me.txtRoom.Value = ""
    Me.txtShift.Value = ""
    Me.txtSupervisor.Value = ""
    Me.txtID.Value = ""
    
    
    End Sub
    
    
    Private Sub cmdEdit_Click()
    'error handler
        On Error GoTo cmdEdit_Click_Error
    'check that there is data to edit
    If Me.txtID = "" Then
    Call MsgBox("The fields are not complete", vbInformation, "Edit Contact")
    Exit Sub
    End If
    Set findvalue = Sheet1.Range("K8:K10000").Find(What:=Me.txtID, LookIn:=xlValues)
    'findvalue.Value = Me.txtID "we do not want to edit the ID"
    findvalue.Offset(0, -1).Value = Me.txtSupervisor.Value
    findvalue.Offset(0, -2).Value = Me.txtShift.Value
    findvalue.Offset(0, -3).Value = Me.txtRoom.Value
    findvalue.Offset(0, -4).Value = Me.txtBuilding.Value
    findvalue.Offset(0, -5).Value = Me.txtUnit.Value
    findvalue.Offset(0, -6).Value = Me.txtTitle.Value
    findvalue.Offset(0, -7).Value = Me.txtDepartment.Value
    findvalue.Offset(0, -8).Value = Me.txtExtension.Value
    findvalue.Offset(0, -9).Value = Me.txtName.Value
    
    
    Call MsgBox("The contact has been updated", vbInformation, "Edit Contact")
    
    
    'reset error
    
    
        On Error GoTo 0
        Exit Sub
    'if error occurs then show me exactly where the error occurs
    cmdEdit_Click_Error:
    
    
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEdit_Click of Form PhoneList"
    
    
    End Sub
    
    
    Private Sub cmdSet_Click()
    'error handler
        On Error GoTo cmdSet_Click_Error
    'reset the form by unload and then reload
    Unload Me
    PhoneList.Show
    'stop edits because we are adding a contact
    PhoneList.cmdEdit.Enabled = False
    'confirmation "All OK" message
    MsgBox "You can now add a contact", vbInformation, "Add New Contact"
    'reset error
        On Error GoTo 0
        Exit Sub
    'of error occurs then show me exactly where  the error occurs
    cmdSet_Click_Error:
    
    
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdSet_Click of Form PhoneList"
    End Sub
    
    
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    
    'error handler
        On Error GoTo ListBox1_DblClick_Error
    'stop a duplicate from being added
    Me.cmdAdd.Enabled = False
    'allow editting
    Me.cmdEdit.Enabled = True
    'send data to the bottom of the form for editting
    Me.txtName.Value = Me.ListBox1.Value
    Me.txtExtension.Value = Me.ListBox1.Column(1)
    Me.txtDepartment.Value = Me.ListBox1.Column(2)
    Me.txtTitle.Value = Me.ListBox1.Column(3)
    Me.txtUnit.Value = Me.ListBox1.Column(4)
    Me.txtBuilding.Value = Me.ListBox1.Column(5)
    Me.txtRoom.Value = Me.ListBox1.Column(6)
    Me.txtShift.Value = Me.ListBox1.Column(7)
    Me.txtSupervisor.Value = Me.ListBox1.Column(8)
    Me.txtID.Value = Me.ListBox1.Column(9)
    
    
        On Error GoTo 0
        Exit Sub
    'if error occurs then show me exactly where the error occurs
    ListBox1_DblClick_Error:
    
    
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ListBox1_DblClick of Form PhoneList"
        
    End Sub
    
    
    Private Sub cmdClear_Click()
    'error handler
    On Error GoTo cmdClear_Click_Error
    'clear the top of form
    Me.cboSelect = ""
    Me.txtSearch = ""
    Me.ListBox1.RowSource = ""
    'clear the bottom of form
    ClearList
    'reset the error
    On Error GoTo 0
    Exit Sub
    'if error occurs then show me exactly where the error occurs
    cmdClear_Click_Error:
    
    
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdClear_Click of Form PhoneList"
    End Sub

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    9,155
    Post Thanks / Like
    Mentioned
    164 Post(s)
    Tagged
    10 Thread(s)

    Default Re: Searching within a cell for ANY match.

    Hi & welcome to MrExcel.
    Try
    Code:
    Set findvalue = Sheet1.Range("K8:K10000").Find(Me.txtID, , xlValues, xlPart, , , False, , False)
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

  3. #3
    New Member
    Join Date
    May 2018
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Searching within a cell for ANY match.

    Thanks for your reply, however, this throws the error "There was an error" which I know there's only one spot with that error which would be this sub -

    Code:
    Private Sub cmdContact_Click()        On Error GoTo errHandler:
            Set DataSH = Sheet1
                DataSH.Range("O8") = Me.cboSelect.Value
                DataSH.Range("O9") = Me.txtSearch.Text
                DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                    "phonelist!Criteria"), CopyToRange:=Range("phonelist!Extract"), Unique:= _
                    False
                    ListBox1.RowSource = Sheet1.Range("outdata").Address(external:=True)
    
    
    Exit Sub
    errHandler:
    MsgBox "There was an error cmdContact_Click"
    End Sub

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    9,155
    Post Thanks / Like
    Mentioned
    164 Post(s)
    Tagged
    10 Thread(s)

    Default Re: Searching within a cell for ANY match.

    Not sure why the change suggested would cause a problem with that sub.
    When you ran cmdEdit_Click did it find & update the sheet?
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

  5. #5
    New Member
    Join Date
    May 2018
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Searching within a cell for ANY match.

    I need to explain how this script works a little better, I could possibly upload it if that'd make it easier.

    This userform has the ability to search (which is all I'm needing for the ANY value), edit, delete and add.

    So I'm realizing now, that edit functionality is what we were adding your change to but really what we need is to edit the search functionality.

    I'm not sure within the code how I would apply what you've sent me to the search functionality and not the edit functionality.

  6. #6
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    9,155
    Post Thanks / Like
    Mentioned
    164 Post(s)
    Tagged
    10 Thread(s)

    Default Re: Searching within a cell for ANY match.

    Which routine are you talking about?
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

  7. #7
    New Member
    Join Date
    May 2018
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Searching within a cell for ANY match.

    I believe this is the part that needs to be modified.

    Code:
    Private Sub cmdContact_Click()        On Error GoTo errHandler:
            Set DataSH = Sheet1
                DataSH.Range("O8") = Me.cboSelect.Value
                DataSH.Range("O9") = Me.txtSearch.Text
                DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                    "phonelist!Criteria"), CopyToRange:=Range("phonelist!Extract"), Unique:= _
                    False
                    ListBox1.RowSource = Sheet1.Range("outdata").Address(external:=True)
    
    
    Exit Sub
    errHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContact_Click of Form PhoneList"
    End Sub

  8. #8
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    9,155
    Post Thanks / Like
    Mentioned
    164 Post(s)
    Tagged
    10 Thread(s)

    Default Re: Searching within a cell for ANY match.

    I don't now much about advanced filters but try
    Code:
    DataSH.Range("O9") = "*" & Me.txtSearch.Text & "*"
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

  9. #9
    New Member
    Join Date
    May 2018
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Searching within a cell for ANY match.

    We're getting closer! Thanks for your help - So With this addition, the search feature works but now my List All Contacts button breaks. I tried just copying that sub and making one specific for the List All Contacts button which I feel should've worked?

    Code:
    Private Sub cmdListAll_Click()        On Error GoTo errHandler:
            cmdClear_Click
            Set DataSH = Sheet1
                DataSH.Range("O8") = Me.cboSelect.Value
                DataSH.Range("O9") = Me.txtSearch.Text
                DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                    "phonelist!Criteria"), CopyToRange:=Range("phonelist!Extract"), Unique:= _
                    False
                    ListBox1.RowSource = Sheet1.Range("outdata").Address(external:=True)
    
    
    Exit Sub
    errHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdListAll_Click of Form PhoneList"
    End Sub

  10. #10
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    9,155
    Post Thanks / Like
    Mentioned
    164 Post(s)
    Tagged
    10 Thread(s)

    Default Re: Searching within a cell for ANY match.

    What are the values in the combo & text boxes?
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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

 

DMCA.com