Juan V Gomez
New Member
- Joined
- Jun 18, 2012
- Messages
- 5
I'm having issues with the following code. What's going on is when a user keys in a name to search for, and it finds multiple occurrences of it, a message pops up saying "We found 'Bob' 5 times" then returns the list of found occurrences into a listbox for the user to select the correct record to edit. What's going on is if you search for a full name (say 'Bob Smith') it counts all the occurrences, returns all the occurrences, works perfect. But if you search for a partial name (say just 'Bob') it counts all the occurrences but only returns the first occurrence and ignores the rest. I have the ("*" & strFind & "*") code in the FindAll function which I assume is why it is counting the occurrances correctly, but I am at a loss as to why it returns the listbox correct when a full name is entered, but not when a partial name is. Anyone have any thoughts?
Also, FYI I apparently don't have permission to attach files, so I'm just posting the code for now.
Thanks for any help
Also, FYI I apparently don't have permission to attach files, so I'm just posting the code for now.
Thanks for any help
Code:
'**************************************************************************************
'Find by Customer Name Button.
'Searches the database by column A for the data entered into the Customer Name Text Box
'For searches where only 1 record is found it returns the data in that row
'For searches where multiple enties are found it uses the FindAll function to populate
'a List Box where the user can then select the record they wish to edit.
'**************************************************************************************
Private Sub cmbFindName_Click()
'Set Variables
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Set rSearch = Sheets("Contacts & Jobs").Range("a3", Range("a65536").End(xlUp)) 'Search from the last row up till cell A3 is reached
Dim f As Integer 'Number or records returned in search
imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
'Search for the data in the CustName Text Box
strFind = Me.CustName.Value
With rSearch
'Search all rows for strFind
Set c = .Find(strFind, LookIn:=xlValues)
'If data is found load the rest of that row into the form
If Not c Is Nothing Then
c.Select
'Loads Form
'TextBox.Value is the Text Box to be populated
'c.Offset(0, X).Value means from column A, offset X number if cells
'Column A is (0, 0). Column B is (0, 1). Column F is (0, 5). Etc.
With Me
.CustName.Value = c.Value
.TerMgr.Value = c.Offset(0, 1).Value
.CompName.Value = c.Offset(0, 2).Value
.JobTitle.Value = c.Offset(0, 3).Value
.MailAdd2.Value = c.Offset(0, 4).Value
.EstCost.Value = c.Offset(0, 5).Value
.ContactDate.Value = c.Offset(0, 6).Value
.PrsptNum.Value = c.Offset(0, 7).Value
.Stage.Value = c.Offset(0, 8).Value
.MailAdd1.Value = c.Offset(0, 11).Value
.SiteAdd1.Value = c.Offset(0, 12).Value
.SiteAdd2.Value = c.Offset(0, 13).Value
.HomePh.Value = c.Offset(0, 14).Value
.WorkPh.Value = c.Offset(0, 15).Value
.MobilePh.Value = c.Offset(0, 16).Value
.FaxNum.Value = c.Offset(0, 17).Value
.EmailAdd.Value = c.Offset(0, 18).Value
.BldgType.Value = c.Offset(0, 19).Value
.SoldDate.Value = c.Offset(0, 20).Value
.ClosedDate.Value = c.Offset(0, 21).Value
.Notes.Value = c.Offset(0, 22).Value
.ProsStage.Value = c.Offset(0, 23).Value
.LastAction.Value = c.Offset(0, 24).Value
.NextAction.Value = c.Offset(0, 25).Value
.cmbAmendName.Enabled = True 'allow for record to be amended
.cmbAmendNumber.Enabled = False 'Button not active, Not search by Number
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = True 'allow for new record to be created
f = 0
End With
FirstAddress = c.Address
Do
f = f + 1 'count number of matching records
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
'If multiple entries are found, return a message box to aleart the user
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
'If user clicks OK, exceute the FindAll function
Case vbOK
FindAll
'If user clicks Cancel, exit out of this funciton
Case vbCancel
End Select
Me.Height = frmMax
End If
'If no matching data is found, pop up a message box to inform the user
Else: MsgBox strFind & " not listed" 'search failed
End If
End With
If Sheets("Contacts & Jobs").AutoFilterMode Then Sheets("Contacts & Jobs").Range("A1").AutoFilter
End Sub
'**************************************************************************************
'FindAll Function
'Finds all records matching the search from Search by Name and returns them to a List Box
'**************************************************************************************
Sub FindAll()
'Set Variables
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Dim c As Range, a() As String, n As Long, I As Long
Set rFilter = Sheets("Contacts & Jobs").Range("a3", Range("a65536").End(xlUp))
Set rng = Sheets("Contacts & Jobs").Range("a3", Range("a65536").End(xlUp))
strFind = Me.CustName.Value 'Search value is CustName
With Sheet1
If Not .AutoFilterMode Then .Range("A3").AutoFilter
rFilter.AutoFilter Field:=1, Criteria1:="*" & strFind & "*"
Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
'Clear any data currently in the List Box
Me.ListBox.Clear
'For each found entry return columns 0 to 32
For Each c In rng
n = n + 1: ReDim Preserve a(0 To 32, 0 To n)
For I = 0 To 32
a(I, n) = c.Offset(, I).Value
Next
Next
End With
'For each record found, enter it into the List Box
If n > 0 Then Me.ListBox.Column = a
End Sub
'**************************************************************************************
'ListBox Function
'Takes the data found between the search function and the FindAll function and inserts
'the basic data into a List Box where a user can then select the proper record to edit or delete
'**************************************************************************************
Private Sub ListBox_Click()
'Checks that there is data to be entered into the listbox.
'If there isn't it pops up a message box
If Me.ListBox.ListIndex = -1 Then 'not selected
MsgBox " No selection made"
'If data is found, the populate the List Box
ElseIf Me.ListBox.ListIndex >= 1 Then 'User has selected
r = Me.ListBox.ListIndex
'TextBox.Value is the Text Box where the data is coming from
'ListBox1.List(r, X) is the cell in the List Box data is entered into
'Column A is (r, 0). Column B is (r, 1). Column F is (r, 5). Etc.
'r equals the row of the List Box data is being entered into.
With Me
.CustName.Value = ListBox.List(r, 0)
.TerMgr.Value = ListBox.List(r, 1)
.CompName.Value = ListBox.List(r, 2)
.JobTitle.Value = ListBox.List(r, 3)
.MailAdd2.Value = ListBox.List(r, 4)
.EstCost.Value = ListBox.List(r, 5)
.ContactDate.Value = ListBox.List(r, 6)
.PrsptNum.Value = ListBox.List(r, 7)
.Stage.Value = ListBox.List(r, 8)
.MailAdd1.Value = ListBox.List(r, 11)
.SiteAdd1.Value = ListBox.List(r, 12)
.SiteAdd2.Value = ListBox.List(r, 13)
.HomePh.Value = ListBox.List(r, 14)
.WorkPh.Value = ListBox.List(r, 15)
.MobilePh.Value = ListBox.List(r, 16)
.FaxNum.Value = ListBox.List(r, 17)
.EmailAdd.Value = ListBox.List(r, 18)
.BldgType.Value = ListBox.List(r, 19)
.SoldDate.Value = ListBox.List(r, 20)
.ClosedDate.Value = ListBox.List(r, 21)
.Notes.Value = ListBox.List(r, 22)
.ProsStage.Value = ListBox.List(r, 23)
.LastAction.Value = ListBox.List(r, 24)
.NextAction.Value = ListBox.List(r, 25)
.cmbAmendName.Enabled = True 'Allow for Amendment by Name
.cmbAmendNumber.Enabled = False 'Button not active. Listbox should only be used when search done by Name
.cmbDelete.Enabled = True 'Allow for record Deletion
.cmbAdd.Enabled = True 'Allow to add a new record
End With
'move to the next row of the List Box
r = r - 1
End If
End Sub
