Searching within a cell for ANY match.

L

la333

New Member
Joined
May 14, 2018
Messages
27
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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Hi & welcome to MrExcel.
Try
Code: 
Set findvalue = Sheet1.Range("K8:K10000").Find(Me.txtID, , xlValues, xlPart, , , False, , False)
 
Upvote 0
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
 
Upvote 0
Not sure why the change suggested would cause a problem with that sub.
When you ran cmdEdit_Click did it find & update the sheet?
 
Upvote 0
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.
 
Upvote 0
Which routine are you talking about?
 
Upvote 0
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
 
Upvote 0
I don't now much about advanced filters but try
Code: 
DataSH.Range("O9") = "*" & Me.txtSearch.Text & "*"
 
Upvote 0
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
 
Upvote 0
What are the values in the combo & text boxes?
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Delete from 2 tables at same time
Replies
2
Views
383
Rfriend
R
J
  • Solved
Run time error for Worksheet Change in VBA
2
Replies
17
Views
430
jtemp57
J
R
  • Question Question
Error 380 - Couldn't set value/column property . Invalid property value or array Index
Replies
0
Views
590
Rfriend
R
D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
72
Denny57
D
S
  • Solved
date formatting within vba
Replies
3
Views
246
shina67
S

Forum statistics

Threads
1,223,901
Messages
6,175,277
Members
452,629
Latest member
SahilPolekar

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top