UserForm Search Function

cmerrick

Board Regular
Joined
Jun 8, 2017
Messages
78
Office Version
  1. 365
Platform
  1. Windows
Good morning all,

I have a code that I am using to enable a UserForm to display info about employees. The user is then able to amend the data and the spreadsheet updates. I've got a search function working but I want the user to be able to search with one option OR the other option not a combination of the two.

My code is below.

Help is much appreciated.

Code:
Private Sub CommandButton3_Click()
row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("All").Range("A" & row_number)
    If item_in_review = NetworkuserSearch.Text Then
        Sheets("All").Range("C" & row_number) = EmployeeIdSearch.Text
        Sheets("All").Range("D" & row_number) = FullnameSearch.Text
        Sheets("All").Range("B" & row_number) = Initials.Text
        Sheets("All").Range("E" & row_number) = Appteam.Text
        Sheets("All").Range("F" & row_number) = Deptcode.Text
        Sheets("All").Range("G" & row_number) = teamcode.Text
        Sheets("All").Range("H" & row_number) = Jobtitle.Text
        Sheets("All").Range("I" & row_number) = emailaddress.Text
        Sheets("All").Range("J" & row_number) = telephoneext.Text
        Sheets("All").Range("K" & row_number) = faxext.Text
        Sheets("All").Range("L" & row_number) = eventassign.Text
        Sheets("All").Range("M" & row_number) = signature.Text
        
     End If
Loop Until item_in_review = ""
        
If MsgBox("Are you sure you wish the submit these changes?", vbQuestion + vbYesNo) <> vbNo Then
     
Unload Me
Else
End If
        
End Sub
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
I just realised I posted the wrong code there, that's to update

Code:
Private Sub CommandButton1_Click()
row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("All").Range("A" & row_number)
    If item_in_review = NetworkuserSearch.Text Then
        EmployeeIdSearch.Text = Sheets("All").Range("C" & row_number)
        FullnameSearch.Text = Sheets("All").Range("D" & row_number)
        Initials.Text = Sheets("All").Range("B" & row_number)
        Appteam.Text = Sheets("All").Range("E" & row_number)
        Deptcode.Text = Sheets("All").Range("F" & row_number)
        teamcode.Text = Sheets("All").Range("G" & row_number)
        Jobtitle.Text = Sheets("All").Range("H" & row_number)
        emailaddress.Text = Sheets("All").Range("I" & row_number)
        telephoneext.Text = Sheets("All").Range("J" & row_number)
        faxext.Text = Sheets("All").Range("K" & row_number)
        eventassign.Text = Sheets("All").Range("L" & row_number)
        signature.Text = Sheets("All").Range("M" & row_number)
    End If
Loop Until item_in_review = ""

End Sub

This is the code I'm using to search I believe
 
Upvote 0
Hi,

what are the options you want & will choice be by selection of an optionbutton or do you just want to search a different range?

Dave
 
Upvote 0
Hi,

The three search functions I want a user to use are 'Network User ID, Employee ID & Full name' these populate column A,C & D respectively.

The search is conducted via text box so all three text boxes with the above labels are displayed at any given time but the user can (or should be able) choose which category they search under to display the remaining info (plus the other info listed in the code)

Kindest regards
 
Upvote 0
Hi,

The three search functions I want a user to use are 'Network User ID, Employee ID & Full name' these populate column A,C & D respectively.

The search is conducted via text box so all three text boxes with the above labels are displayed at any given time but the user can (or should be able) choose which category they search under to display the remaining info (plus the other info listed in the code)

Kindest regards

Hi,
you should only need one search textbox to do what you want.

Make a back-up of your workbook & then try these updates to your codes

1 - delete two of the search textboxes & rename remaining one "SearchBox"

replace forms codes with following:

Code:
Option Base 1
Dim Search As String
Dim wsAll As Worksheet
Dim FoundCell As Range


Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim SearchRange As Range


    Search = SearchBox.Text
    
    With wsAll
        Set SearchRange = Union(.Columns(1), .Columns(2), .Columns(3))
    End With
    
    Set FoundCell = SearchRange.Find(Search, lookat:=xlWhole, LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
    
    For i = 1 To UBound(FormControls)
        Me.Controls(FormControls(i)).Text = wsAll.Cells(FoundCell.Row, i + 1).Value
    Next i
        Me.CommandButton3.Enabled = True
    Else
        MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
    End If


End Sub


Private Sub CommandButton3_Click()
    Dim msg As VbMsgBoxResult
'update record
    msg = MsgBox("Are you sure you wish the submit these changes?", 36, "Confirm Changes")
     If msg = vbNo Then Exit Sub


    For i = 1 To UBound(FormControls)
    With Me.Controls(FormControls(i))
        wsAll.Cells(FoundCell.Row, i + 1).Value = .Text
        .Text = ""
    End With
    Next i
    
    Me.CommandButton3.Enabled = False
    
    MsgBox Search & Chr(10) & "Record Updated", 48, "Updated"
End Sub


Function FormControls() As Variant
    FormControls = Array("Initials", "EmployeeIdSearch", "FullnameSearch", "Appteam", "Deptcode", "teamcode", _
                        "Jobtitle", "emailaddress", "telephoneext", "faxext", "eventassign", "Signature")
End Function


Private Sub UserForm_Initialize()
    Set wsAll = ThisWorkbook.Worksheets("All")
    Me.CommandButton3.Enabled = False
End Sub

Note the variables outside of any procedure - These MUST sit at the very TOP of your forms code page.

Not fully tested & may need some adjustment but code should search Columns 1 - 3 for search term you enter & return the found record.


Hope helpful

Dave
 
Upvote 0
Ok, I've taken your advice and done away with the other two search options. Users can just search via Full Name now.

Code has remained largely the same and only the 'item_in_review' has changed.

Another thing I wanted to know is if it's possible to pull through the results of an option button back into the user form.

So basically, a user completes a User Form to create a record on the data tab, later they want to amend the entry so they pull up the userform and search for the entry. Using the code above all of the areas populate apart from when was selected on the Options Buttons.

Thanks
 
Upvote 0
yes it is possible but Optionbutton controls were not shown in codes you published - you will need to publish code you use with these controls.

Also, need to understand if you adopted my code solution or still using what you published.

Dave
 
Upvote 0
Dave,

Thanks for the response.

The code you provided has not been used, with no offence intended the code I had already did what I needed it to I just want to know if the search option could be expanded to 1 or 2 or 3 options without changing the fields. I have saved your code for later usage though.

With regards to the new question,

Code I currently have is;

Rich (BB code):
 Private Sub CommandButton1_Click()
If Networkuser.Value = "" Or Initials.Value = "" Or EmployeeId.Value = "" Or Fullname.Value = "" Or Appteam.Value = "" Or Deptcode.Value = "" Or teamcode.Value = "" Or Jobtitle.Value = "" Or emailaddress.Value = "" Or telephoneext.Value = "" Or faxext.Value = "" Or eventassign.Value = "" Or signature.Value = "" Then
    If MsgBox("Some fields have not been completed. Do you wish to continue?", vbQuestion + vbYesNo) <> vbYes Then
    Exit Sub
    
    End If
    
End If
Unload UserForm1
MsgBox "Your entry has been created"
Dim emptyRow As Long
 'Make Sheet2 active
 Sheet2.Activate
 
 'Determine emptyRow
 emptyRow = Sheets(2).Range("T" & Rows.Count).End(xlUp).Row + 1
 
 'Transfer information
 Cells(emptyRow, 1).Value = Networkuser.Value
 Cells(emptyRow, 2).Value = Initials.Value
 Cells(emptyRow, 3).Value = EmployeeId.Value
 Cells(emptyRow, 4).Value = Fullname.Value
 Cells(emptyRow, 5).Value = Appteam.Value
 Cells(emptyRow, 6).Value = Deptcode.Value
 Cells(emptyRow, 7).Value = teamcode.Value
 Cells(emptyRow, 8).Value = Jobtitle.Value
 Cells(emptyRow, 9).Value = emailaddress.Value
 Cells(emptyRow, 10).Value = telephoneext.Value
 Cells(emptyRow, 11).Value = faxext.Value
 Cells(emptyRow, 12).Value = eventassign.Value
 Cells(emptyRow, 13).Value = signature.Value
 
If yes1.Value = True Then
     Cells(emptyRow, 14).Value = "Y"
Else
     Cells(emptyRow, 14).Value = "N"
     
End If
     
If yes2.Value = True Then
     Cells(emptyRow, 15).Value = "Y"
Else
     Cells(emptyRow, 15).Value = "N"
     
End If
     
If yes3.Value = True Then
     Cells(emptyRow, 16).Value = "Y"
Else
     Cells(emptyRow, 16).Value = "N"
     
End If
     
If yes4.Value = True Then
     Cells(emptyRow, 17).Value = "Y"
Else
     Cells(emptyRow, 17).Value = "N"
     
End If
     
If yes5.Value = True Then
     Cells(emptyRow, 18).Value = "Y"
Else
     Cells(emptyRow, 18).Value = "N"
     
End If
     
If O6.Value = True Then
     Cells(emptyRow, 19).Value = "O"
Else
     Cells(emptyRow, 19).Value = "U"
End If
     
If yes7.Value = True Then
     Cells(emptyRow, 20).Value = "Y"
Else
     Cells(emptyRow, 20).Value = "N"
     
End If
End Sub

The bold sections display what is currently transferring the option box info into the spreadsheet. I now wish to recall the option box selection (as my above code does for text boxes) amend it, and reapply it to the spreadsheet in a similar fashion.

Regards
 
Upvote 0
try:

Rich (BB code):
Private Sub CommandButton1_Click()
Dim i As Integer
row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("All").Range("A" & row_number)
    If item_in_review = NetworkuserSearch.Text Then
        EmployeeIdSearch.Text = Sheets("All").Range("C" & row_number)
        FullnameSearch.Text = Sheets("All").Range("D" & row_number)
        Initials.Text = Sheets("All").Range("B" & row_number)
        Appteam.Text = Sheets("All").Range("E" & row_number)
        Deptcode.Text = Sheets("All").Range("F" & row_number)
        teamcode.Text = Sheets("All").Range("G" & row_number)
        Jobtitle.Text = Sheets("All").Range("H" & row_number)
        emailaddress.Text = Sheets("All").Range("I" & row_number)
        telephoneext.Text = Sheets("All").Range("J" & row_number)
        faxext.Text = Sheets("All").Range("K" & row_number)
        eventassign.Text = Sheets("All").Range("L" & row_number)
        Signature.Text = Sheets("All").Range("M" & row_number)
    
    For i = 1 To 7
    With Sheets("All").Cells(row_number, 13 + i)
        Me.Controls("yes" & i).Value = CBool(.Text = "Y" Or .Text = "O")
    End With
    Next i
    End If
Loop Until item_in_review = ""

Dave
 
Upvote 0
Thank you very much,

Doesn't seem to like;

Code:
Me.Controls("yes" & i).Value = CBool(.Text = "Y" Or .Text = "O")
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

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