I've modified the code provided in this thread by Warship to make data entry userforms that allow our staff to search through an Excel file in which we keep a database of customer information. It produces a list of all results that match any one of the three searching criteria entered, and by clicking on the correct entry, puts the information into the userform so that it's quicker for those doing data entry to enter interactions with certain customers. Searching with the following variables: First Name: John and Last Name: Smith, I would get a list of all people with the first name John AND all people with the last name Smith. For example, it might produce the following list:
BillyJohn Smith
JoJohn Abe
John Abraham
Johnny Birch
Johnson Carver
John Smith
Johnathan Smith
Johnathan Smithsonian
Robert Smith
Sam Smith
Tyler Smith
Zach Smithy
Our database is and very likely will remain small enough for this to be entirely functional for the next decade or so, but I'm interested in whether it might be possible to search by the first and the last name such that it only finds names that match both. So from the above list, *if* both fields have something in them (<> "") I'd like it to provide only the names in blue in the above list.
As an addendum that may be relevant to the search criteria question, some customers have data in Column A that notes if there's something a worker may need to know while dealing with them (such as past failures to pay, other reasons to contact management before finalizing an order). Would it be possible to make the listbox display results that have any data in a given Column (specifically in this case, column A) differently, say with a yellow or pink background, etc.?
Here's the code as I have it now, with the section in ##### where I suppose a search by first and last name (dual criteria matches only) might go.
There's a comment note before almost everything because I'm extremely new to Excel VBA (started 9 days ago today) and want to understand the code I'm writing. I've found the examples on this forum extremely helpful in making our data entry processes much less cumbersome. Therefore, if you have suggestions to make any code cleaner or better, I also welcome any advice or teaching you may have. Thank you.
BillyJohn Smith
JoJohn Abe
John Abraham
Johnny Birch
Johnson Carver
John Smith
Johnathan Smith
Johnathan Smithsonian
Robert Smith
Sam Smith
Tyler Smith
Zach Smithy
Our database is and very likely will remain small enough for this to be entirely functional for the next decade or so, but I'm interested in whether it might be possible to search by the first and the last name such that it only finds names that match both. So from the above list, *if* both fields have something in them (<> "") I'd like it to provide only the names in blue in the above list.
As an addendum that may be relevant to the search criteria question, some customers have data in Column A that notes if there's something a worker may need to know while dealing with them (such as past failures to pay, other reasons to contact management before finalizing an order). Would it be possible to make the listbox display results that have any data in a given Column (specifically in this case, column A) differently, say with a yellow or pink background, etc.?
Here's the code as I have it now, with the section in ##### where I suppose a search by first and last name (dual criteria matches only) might go.
Code:
Private Sub ButtonSearch_Click()
'Exit form if search fields are blank.
If DataFirstName = "" And DataLastName = "" And DataIDNumber = "" Then
MsgBox ("Needs at least a first name, last name, or an ID Number.")
Exit Sub
End If
'Declare Variables for Search Function
Dim rgData As Range
Dim rgResults As Range
Dim ListRow As Long
Dim SkipEvent As Boolean
Dim shData As Worksheet
Dim shCurrent As Worksheet
Dim shResults As Worksheet
Dim found As Range
Dim firstFound As String
Dim SrchCol_1 As String
Dim SrchCol_2 As String
Dim SrchCol_3 As String
Dim r As Long
'Stops screen updating while working with DataBase File.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Open DataBase File workbook, then sets it as the active workbook for the indented portion of code in order to reference it.
Workbooks.Open Filename:="C:\DataBase.xls", UpdateLinks:=True, ReadOnly:=True
Set wbBook = Workbooks("DataBase.xls")
'Hides DataBase from Taskbar
'ActiveWindow.Visible = False
Set shData = Sheets("DataBase")
Set rgData = shData.Cells.CurrentRegion
Set rgData = rgData.Offset(1, 0).Resize(rgData.Rows.Count - 1, rgData.Columns.Count)
Set shCurrent = ActiveSheet
'Keep errors from popping up or interrupting while cleaning out possible past Results sheets.
Application.DisplayAlerts = False
On Error Resume Next
'Delete Results sheet which shouldn't exist, just in case it does.
Sheets("Results").Delete
On Error GoTo 0
'Turn back on error notifs.
Application.DisplayAlerts = True
'Add Results Sheet after the last of however many sheets there are.
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Results"
Set shResults = Sheets("Results")
With shResults
.Cells(1, 1) = "DataRow" 'Needed for coding/debug purposes. Set width to 0 in listbox properties.
.Cells(1, 2) = "Call Management"
.Cells(1, 3) = "Contact Method Preferred"
.Cells(1, 4) = "Street"
.Cells(1, 5) = "Zip, City, State"
.Cells(1, 6) = "First"
.Cells(1, 7) = "Last"
.Cells(1, 8) = "ID#"
.Cells(1, 9) = "Company Name"
.Cells(1, 10) = "Last Contract"
.Cells(1, 11) = "Header 10"
.Cells(1, 12) = "Age"
.Cells(1, 13) = "Race"
.Cells(1, 14) = "County"
.Cells(1, 15) = "Phone"
.Cells(1, 16) = "Times Servicing"
End With
'columns to search through
SrchCol_1 = "E" 'First Name
SrchCol_2 = "F" 'Last Name
SrchCol_3 = "G" 'ID Number
' ???? Added to try to make it work.
SrchCol_4 = "E:F" 'First and Last
'Unselects any listbox selections to prevent errors upon clearing out the data for new search.
ListBoxSearchResults.ListIndex = -1
r = 1
'Search First Name
If DataFirstName <> "" And DataLastName = "" Then
With rgData.Columns(SrchCol_1)
'Find whatever's in first name, within the range specified as rgData, with partial finds allowed.
Set found = .Find(DataFirstName, rgData.Cells(rgData.Rows.Count, SrchCol_1))
If Not found Is Nothing Then
firstFound = found.Address
Do 'Paste the found data in the sheet, move the data to the right to add next finds. Dakara Itta
r = r + 1
found.EntireRow.Copy shResults.Cells(r, 1)
shResults.Cells(r, 1).Insert Shift:=xlToRight
shResults.Cells(r, 1) = found.Row
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstFound
End If
End With
End If
'Search Last Name
If DataLastName <> "" And DataFirstName = "" Then
With rgData.Columns(SrchCol_2)
Set found = .Find(DataLastName, rgData.Cells(rgData.Rows.Count, SrchCol_2))
If Not found Is Nothing Then
firstFound = found.Address
Do
r = r + 1
found.EntireRow.Copy shResults.Cells(r, 1)
shResults.Cells(r, 1).Insert Shift:=xlToRight
shResults.Cells(r, 1) = found.Row
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstFound
End If
End With
End If
[COLOR=#0000ff] 'Search First and Last Name[/COLOR]
[COLOR=#0000ff] If DataFirstName <> "" And DataLastName <> "" Then 'Only records that have some connection to both names.[/COLOR]
[COLOR=#0000ff] With rgData.Columns(SrchCol_4)[/COLOR]
[COLOR=#0000ff] ' ##### I know such a thing as the below code won't work.[/COLOR]
[COLOR=#0000ff] Set found = .Find(DataFirstName, rgData.Cells(rgData.Rows.Count, SrchCol_1)) And .Find(DataLastName, rgData.Cells(rgData.Rows.Count, SrchCol_2))[/COLOR]
[COLOR=#0000ff] ' #########[/COLOR]
[COLOR=#0000ff] If Not found Is Nothing Then[/COLOR]
[COLOR=#0000ff] firstFound = found.Address[/COLOR]
[COLOR=#0000ff] Do[/COLOR]
[COLOR=#0000ff] r = r + 1[/COLOR]
[COLOR=#0000ff] found.EntireRow.Copy shResults.Cells(r, 1)[/COLOR]
[COLOR=#0000ff] shResults.Cells(r, 1).Insert Shift:=xlToRight[/COLOR]
[COLOR=#0000ff] shResults.Cells(r, 1) = found.Row[/COLOR]
[COLOR=#0000ff] Set found = .FindNext(found)[/COLOR]
[COLOR=#0000ff] Loop While Not found Is Nothing And found.Address <> firstFound[/COLOR]
[COLOR=#0000ff] End If[/COLOR]
[COLOR=#0000ff] End With[/COLOR]
[COLOR=#0000ff] End If[/COLOR]
'Search ID Number
If DataIDNumber <> "" Then
With rgData.Columns(SrchCol_3)
Set found = .Find(DataIDNumber, rgData.Cells(rgData.Rows.Count, SrchCol_3))
If Not found Is Nothing Then
firstFound = found.Address
Do
r = r + 1
found.EntireRow.Copy shResults.Cells(r, 1)
shResults.Cells(r, 1).Insert Shift:=xlToRight
shResults.Cells(r, 1) = found.Row
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstFound
End If
End With
End If
If r = 1 Then
ListBoxSearchResults.RowSource = ""
MsgBox "No Matches Found'."
Else
Set rgResults = shResults.Cells.CurrentRegion
Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, rgResults.Columns.Count)
'Remove duplicates in the first and last name columns (5, 6).
rgResults.RemoveDuplicates Columns:=Array(5, 6), Header:=xlNo
Set rgResults = shResults.Cells.CurrentRegion
Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, rgResults.Columns.Count)
ActiveWorkbook.Names.Add Name:="rgResults", RefersTo:=rgResults
ListBoxSearchResults.RowSource = "rgResults"
End If
shCurrent.Activate
Application.ScreenUpdating = True
'Turn on Screen Updating once search is finished.
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Activates Intake Form Again
ThisWorkbook.ActivateThere's a comment note before almost everything because I'm extremely new to Excel VBA (started 9 days ago today) and want to understand the code I'm writing. I've found the examples on this forum extremely helpful in making our data entry processes much less cumbersome. Therefore, if you have suggestions to make any code cleaner or better, I also welcome any advice or teaching you may have. Thank you.
