Searching within a cell for ANY match.

[la333]

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.

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

 

[la333]

The values are dynamic - they're defined by the user.

cboSelect is a drop down - Name, Extension, Department, etc.

txtSearch is what the user is inputting to search for.

The List All button just clears everything and does a blank combo and blank text search which pulls up the entire list of entries.

 

[Fluff]

Why not just read the original unfiltered range into the listbox?

 

[la333]

Thanks a lot for setting me in the right direction. I was able to get it working by making it clear the cbo and txt fields another way.

However, I am curious - is it possible to take what's been extracted from the search and now sort it by any of the cboSelect drop down items?

Thanks again for your help!

 

[Fluff]

Probably, but without knowing what your data looks like, or what values you have in the combo, it's difficult to tell.
I suspect that you would need to use a custom sort list

 

[la333]

Ok, I'll do some more learning for that first! But apparently I've spoken too soon. I've gotten the search to work for Name, Department, Title, Unit, Shift, Supervisor but with the *VALUE* it will not search for Extension, Building Number or Room Number.

Any idea why that would be? Seems they're all numbers and you'd be typing in the entire field and it won't work. If I type 3498 which is the entire extension, it does not come back with a search, just an error. Same for Building 515 or Room 115....

 

[Fluff]

I think that's something to do with the way that advanced filter works, but not sure.