Magic Polygon
New Member
- Joined
- Aug 20, 2023
- Messages
- 30
- Office Version
- 2019
- Platform
- Windows
I would like to post my Excel Spreadsheet, but I don't know if it is possible. Please let me know what I could do to better ask my question. Below is an attempt at giving context to my problem. With the initial data, SearchResultsListBox ends up having one item, but the item is empty.
BrowseTextBox.Value is "Alpha"
BrowseByComboBox.Value is "First Name"
Column B is the column for "First Name"
The image is part of "AppointmentsTable" table in the "Appointments" worksheet.
BrowseTextBox.Value is "Alpha"
BrowseByComboBox.Value is "First Name"
Column B is the column for "First Name"
The image is part of "AppointmentsTable" table in the "Appointments" worksheet.
VBA Code:
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
Dim SearchListBoxArray() As Variant
Dim SearchArrayColumn As Integer
' Display an error if no search term is entered
If BrowseTextBox.Value = "" Then
MsgBox "No search term specified", vbCritical + vbOKOnly
Exit Sub
End If
' Determine the search criteria based on the combo box value
Select Case BrowseByComboBox.Value
Case "First Name", "Surname", "Appointment", "Next Appointment", "Dog Name", "Breed"
SearchTerm = BrowseTextBox.Value
SearchColumn = BrowseByComboBox.Value
Case Else
' Handle unknown or invalid search criteria here
MsgBox "Please choose a term to browse by."
Exit Sub
End Select
SearchResultsListBox.Clear
' Only search in the relevant table column i.e. if somone is searching Location
' only search in the Location column
With Worksheets("Appointments").ListObjects("AppointmentsTable").ListColumns(SearchColumn).Range
' Find the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
' If a match has been found
If Not RecordRange Is Nothing Then
'Cell address of the first match
FirstAddress = RecordRange.Address
'Initialise the row count
RowCount = -1
'Determine how many rows there will be
Do
RowCount = RowCount + 1
'Look for next match
Set RecordRange = .FindNext(RecordRange)
Loop While RecordRange.Address <> FirstAddress
'Resize SearchListBoxArray
ReDim Preserve SearchListBoxArray(0 To RowCount, 0 To 12)
'Reinitialise the row count
RowCount = -1
'Reset RecordRange to be the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
Do
'Create a new row for ListBox
RowCount = RowCount + 1
'Set the first cell in the row of the matching value
Set FirstCell = Range("B" & RecordRange.Row)
' Add an item to the List Box
SearchResultsListBox.AddItem
For SearchArrayColumn = 0 To 12
'Populate the array
SearchListBoxArray(RowCount, SearchArrayColumn) = FirstCell(1, SearchArrayColumn + 1)
Next SearchArrayColumn
' Look for next match
Set RecordRange = .FindNext(RecordRange)
' When no further matches are found, exit the sub
If RecordRange Is Nothing Then
'Format and populate list box using built array
SearchResultsListBox.ColumnHeads = True
SearchResultsListBox.ColumnCount = 13
SearchResultsListBox.ColumnWidths = "50,50,50,50,50,50,50,50,50,50,50,50,50"
SearchResultsListBox.List = SearchListBoxArray
Exit Sub
End If
' Keep looking while unique matches are found
Loop While RecordRange.Address <> FirstAddress
Else
' If you get here, no matches were found
SearchResultsListBox.AddItem
SearchResultsListBox.List(0, 0) = "Nothing Found"
End If
End With