Partial Match VBA - Search Button

amoverton2 · Aug 20, 2021

Hi,

I'm new to the VBA coding aspect of excel, and this morning is going by really fast and I don't have time to search everything out so If the answer is somewhere in this forum please direct me.

I have a userform set up with a couple of text boxes and a list box. I want to have a search button that searches down one column on the same page on a sheet and return all results (does not have to be an exact match) into the Listbox from there I can double click the name and the rest of the information in the row shows up in other textboxes (I've figured the double click and display, though I don't know how to clear the listbox upon bringing up the userform). Also,what I don't know is how to code the search button to search a certain column (say column B) and show the results of that row in the listbox to be able to double click, edit and save (figured out edit and save).

Thanks for your help!

dmt32 · Aug 20, 2021

Hi,
Should not need a search button as you can populate your listbox with matching results as you type text in your search textbox
Searching a single column is straight forward but to assist with code just need to understand if all the columns in your worksheet need to be displayed & if so, how many are there? or do you need just a select few? e.g. | Staff Number | First Name | Last Name |

Helpful if could share your worksheet with dummy data using MrExcel Addin XL2BB - Excel Range to BBCode

Dave

amoverton2 · Aug 21, 2021

Okay, so here we go:

My vision:
1. I want to put a name in the textbox at the top, it then populates in the listbox (If I need a search button that's cool, otherwise filter as I type would be cool).
2. Once the name shows up in the listbox, I want to click (or double-click) the record and the information populates into the 4 textboxes below the listbox (or not if there is missing information (missing information is not something I care about, so no need for validations)
3. Once information is populated from the click or double click I want to update or add information to the sheet E_Sponsor_Add (honestly, I think both the add and update buttons do the same thing in this userform so I'm cool with one being dropped
4. I understand the clear/delete/save and close vbas, no need to change these unless it interferes with steps 1, 2, or 3.

Note: So I'm having trouble clearing the listbox at the beginning when running the userform vba (not sure what to do about that I want it to show up empty with the headers though)

Here is the dummy info on the sheet that my userform add/updates/saves to:

Future List.xlsm

A

B

C

D

E

F

G

H

1

ID

Prospective Gain

Sponsor Rate

Sponsor Last,First Name

Cell Phone #

Email

Submitted By

Updated

2

1

SMITH,ADAM

ITC

PIE,APPLE

(909) 876-5234

sweet@gmail.com

TRULY,YOURS

21-Jan-21 10:11:00 AM

3

2

WASHINGTON, JOHN

PRC

PUMPKIN,PEACHES

(454) 363-2821

ppumpkin@aol.com

TRULY,YOURS

3-Mar-21 12:00:00 PM

4

3

DOE,JANE

HTC

PUMP,DESTINY

(876) 345-9012

pump@yahoo.com

TRULY,YOURS

13-Apr-21 1:45:00 PM

5

4

MARCIANO,LUCKY

GMC

TOTO,AFRICA

(123) 456-7890

toto.africa@gmail.com

TRULY,YOURS

18-Feb-21 6:00:00 AM

6

5

CAPONE,AL

FCC

GILMORE,HAPPY

(213) 495-0098

happy.gilmore@yahoo.com

TRULY,YOURS

22-Jul-21 3:00:00 PM

7

6

MONTANA,TONY

ATC

FIELDS,STRAWBERRY

(315) 909-7654

straw.fields@aol.com

TRULY,YOURS

1-Jun-21 1:00:00 AM

8

7

LOPEZ,ANGELINA

DCC

BOND,JAMES

(555) 459-8989

james.bond@gmail.com

TRULY,YOURS

31-Mar-20 8:00:00 AM

E_Sponsor_Add

Cell Formulas
Range	Formula
A2:A8	A2	=ROW()-1

Here is my VBA Code (if it needs editing please let me know, I'm not smart enough yet to create code just copy from tutorials and understand somewhat)
USERFORM:

Private Sub UserForm_Activate()
Call Refresh_Data
End Sub

Sub Refresh_Data()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("E_Sponsor_Add")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

With Me.lstDatabase
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = "0,120,50,120,90,200,0,0"

If last_row = 1 Then
.RowSource = "E_Sponsor_Add!A2:H2"
Else
.RowSource = "E_Sponsor_Add!A2:H" & last_row
End If

End With
End Sub

Private Sub cmdADD_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("E_Sponsor_Add")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

sh.Range("A" & last_row + 1).Value = "=Row()-1"
sh.Range("C" & last_row + 1).Value = Me.txtRATE.Value
sh.Range("D" & last_row + 1).Value = Me.txtNAME.Value
sh.Range("E" & last_row + 1).Value = Me.txtPHONE.Value
sh.Range("F" & last_row + 1).Value = Me.txtEMAIL.Value
sh.Range("G" & last_row + 1).Value = Application.UserName
sh.Range("H" & last_row + 1).Value = Now

Me.txtRATE.Value = ""
Me.txtNAME.Value = ""
Me.txtPHONE.Value = ""
Me.txtEMAIL.Value = ""

Call Refresh_Data
End Sub

Private Sub cmdCLEAR_Click()
Me.txtPG.Value = ""
Me.txtRATE.Value = ""
Me.txtNAME.Value = ""
Me.txtPHONE.Value = ""
Me.txtEMAIL.Value = ""
End Sub

Private Sub cmdCLOSE_Click()
Unload addSponsorE
End Sub

Private Sub cmdDELETE_Click()
If Me.TextBox1.Value = "" Then
MsgBox "Select Sponsor to Delete"
Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("E_Sponsor_Add")
Dim Selected_row As Long
Selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), sh.Range("A:A"), 0)

sh.Range("A" & Selected_row).EntireRow.Delete
Call Refresh_Data

Me.txtRATE.Value = ""
Me.txtNAME.Value = ""
Me.txtPHONE.Value = ""
Me.txtEMAIL.Value = ""
Me.TextBox1.Value = ""
End Sub

Private Sub cmdSAVE_Click()
ThisWorkbook.Save
MsgBox "Sponsor Information Saved"
End Sub

Private Sub cmdUPDATE_Click()
If Me.TextBox1.Value = "" Then
MsgBox "Select Sponsor to Update"
Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("E_Sponsor_Add")
Dim Selected_row As Long
Selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), sh.Range("A:A"), 0)

sh.Range("C" & Selected_row).Value = Me.txtRATE.Value
sh.Range("D" & Selected_row).Value = Me.txtNAME.Value
sh.Range("E" & Selected_row).Value = Me.txtPHONE.Value
sh.Range("F" & Selected_row).Value = Me.txtEMAIL.Value
sh.Range("G" & Selected_row).Value = Application.UserName
sh.Range("H" & Selected_row).Value = Now

Me.txtRATE.Value = ""
Me.txtNAME.Value = ""
Me.txtPHONE.Value = ""
Me.txtEMAIL.Value = ""
Me.TextBox1.Value = ""

Call Refresh_Data
End Sub

Private Sub lstDatabase_Click()
Me.TextBox1.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0)
Me.txtRATE.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
Me.txtNAME.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
Me.txtPHONE.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
Me.txtEMAIL.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
End Sub
----------------------------------
MODULE CODE:

Sub AssignSponsor_Click()
addSponsorE.Show
End Sub
-----------------------------------
USERFORM IMAGE:

dmt32 · Aug 21, 2021

Hi,

As you are using RowSource to populate the listbox you will need to disconnect this in order to clear the listbox but using Rowsource property has some drawbacks – Because you want to display the column headers RowSource property is the only option you cannot though however, use the property with filtered data.

Couple of work arounds maybe

1 - use a separate sheet in which to copy the filtered data and setting RowSource to the new range.

2 - have filtered list show in another listbox (like a dropdown display) and selection selects record in main listbox.

3 - use the List property of the control which accepts an array – your column headers can be labels placed at top of the listbox positioned accordingly.

To save changing your codes too much, we can try Option 2 & see if this will work you

To start,

1 - Make a BACKUP of your workbook.

2 - place following additional controls on your userform

TextBox – named “txtSearch”
ListBox – named “ListBox1”

The txtSearch textbox should be placed to the right of your first textbox (TextBox1)

ListBox1 should be placed just underneath txtSearch textbox – you can manually size it to same width & height as the textbox but do not worry if it overlaps existing Listbox.

3 – DELETE ALL existing code in your userform and replace with following

Code:

Dim sh              As Worksheet
Dim EventsOff       As Boolean
Private Sub ListBox1_Click()
    EventsOff = True
    With Me.ListBox1
        Me.lstDatabase.ListIndex = .Value - 1
        .Visible = False
        Me.txtSearch.Value = .Column(1)
    End With
    EventsOff = False
End Sub

Private Sub txtSearch_Change()
    If EventsOff Then Exit Sub
    SearchRecords Me, sh, Me.txtSearch
End Sub

Private Sub UserForm_Activate()
    Call Refresh_Data
End Sub

Sub Refresh_Data()
    
    Dim last_row    As Long
    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
    
    With Me.lstDatabase
        .ColumnHeads = True
        .ColumnCount = 8
        .ColumnWidths = "0,120,50,120,90,200,0,0"
        
        If last_row = 1 Then
            .RowSource = "E_Sponsor_Add!A2:H2"
        Else
            .RowSource = "E_Sponsor_Add!A2:H" & last_row
        End If
        
    End With
End Sub

Private Sub cmdADD_Click()
    
    Dim last_row    As Long
    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
    
    sh.Range("A" & last_row + 1).Value = "=Row()-1"
    sh.Range("C" & last_row + 1).Value = Me.txtRATE.Value
    sh.Range("D" & last_row + 1).Value = Me.txtNAME.Value
    sh.Range("E" & last_row + 1).Value = Me.txtPHONE.Value
    sh.Range("F" & last_row + 1).Value = Me.txtEMAIL.Value
    sh.Range("G" & last_row + 1).Value = Application.UserName
    sh.Range("H" & last_row + 1).Value = Now
    
    Me.txtRATE.Value = ""
    Me.txtNAME.Value = ""
    Me.txtPHONE.Value = ""
    Me.txtEMAIL.Value = ""
    
    Call Refresh_Data
End Sub

Private Sub cmdCLEAR_Click()
    Me.txtPG.Value = ""
    Me.txtRATE.Value = ""
    Me.txtNAME.Value = ""
    Me.txtPHONE.Value = ""
    Me.txtEMAIL.Value = ""
End Sub

Private Sub cmdCLOSE_Click()
    Unload addSponsorE
End Sub

Private Sub cmdDELETE_Click()
    If Me.TextBox1.Value = "" Then
        MsgBox "Select Sponsor To Delete"
        Exit Sub
    End If
    
    Dim Selected_row As Long
    Selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), sh.Range("A:A"), 0)
    
    sh.Range("A" & Selected_row).EntireRow.Delete
    Call Refresh_Data
    
    Me.txtRATE.Value = ""
    Me.txtNAME.Value = ""
    Me.txtPHONE.Value = ""
    Me.txtEMAIL.Value = ""
    Me.TextBox1.Value = ""
End Sub

Private Sub cmdSAVE_Click()
    ThisWorkbook.Save
    MsgBox "Sponsor Information Saved"
End Sub

Private Sub cmdUPDATE_Click()
    If Me.TextBox1.Value = "" Then
        MsgBox "Select Sponsor To Update"
        Exit Sub
    End If
    
    Dim Selected_row As Long
    Selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), sh.Range("A:A"), 0)
    
    sh.Range("C" & Selected_row).Value = Me.txtRATE.Value
    sh.Range("D" & Selected_row).Value = Me.txtNAME.Value
    sh.Range("E" & Selected_row).Value = Me.txtPHONE.Value
    sh.Range("F" & Selected_row).Value = Me.txtEMAIL.Value
    sh.Range("G" & Selected_row).Value = Application.UserName
    sh.Range("H" & Selected_row).Value = Now
    
    Me.txtRATE.Value = ""
    Me.txtNAME.Value = ""
    Me.txtPHONE.Value = ""
    Me.txtEMAIL.Value = ""
    Me.TextBox1.Value = ""
    
    Call Refresh_Data
End Sub

Private Sub lstDatabase_Click()
    Me.TextBox1.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0)
    Me.txtRATE.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
    Me.txtNAME.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
    Me.txtPHONE.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
    Me.txtEMAIL.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
End Sub

Private Sub UserForm_Initialize()
    
    Set sh = ThisWorkbook.Sheets("E_Sponsor_Add")
    
    With Me.txtSearch
        .Top = Me.TextBox1.Top
        .Width = 130
        .Left = Me.lstDatabase.Left - (.Width - Me.lstDatabase.Width)
    End With
    
    With Me.ListBox1
        .Width = 196
        .Left = Me.txtSearch.Left - (Me.txtSearch.Width) / 2
        .Top = Me.txtSearch.Top + Me.txtSearch.Height + 1
        .ColumnCount = 2
        .ColumnWidths = "20 pt;100 pt"
        .Visible = False
    End With
    
End Sub

4 – Place Following code in STANDARD module

Code:

Sub SearchRecords(ByVal Form As Object, sh As Object, ByVal Search As String)
    Dim i               As Long
    Dim arr             As Variant
    Const ListBoxMinHeight As Integer = 70, ListBoxMaxHeight As Integer = 250
    'column you are searching
    Const SearchColumn As Integer = 2
    
    'worksheet data range (sheet MUST NOT be protected)
    Set rng = sh.Range("A1").CurrentRegion
    
    'create array from range
    arr = rng.Value2
    
    With Form.ListBox1
        .Clear
        .IntegralHeight = True
        .Font.Size = 10
        If Len(Search) = 0 Then .Visible = False: Exit Sub
        
        For i = 1 To UBound(arr, 1)
            If UCase(arr(i, SearchColumn)) Like UCase(Search) & "*" Then
                'ID
                .AddItem arr(i, 1)
                'name
                .List(.ListCount - 1, 1) = arr(i, 2)
            End If
        Next i
        
        .Visible = .ListCount > 0
        
        If .Visible Then
            .Height = .ListCount * .Font.Size * 1.3
            .Height = IIf(.Height > ListBoxMaxHeight, ListBoxMaxHeight, _
                      IIf(.Height < ListBoxMinHeight, ListBoxMinHeight, .Height))
        End If
    End With
End Sub

Search is set to values in Column B of your worksheet & when you start to enter text, the listbox should appear displaying all matches. The More characters you enter will filter the data to a closer match. Clicking on a record should select it in the Main listbox which in turn, should populate all other textboxes.

Hopefully, this will go in right direction for you.

Dave

amoverton2 · Aug 23, 2021

How do I get the search text box that I type in to be in the middle of the userform next to the label Prospective Gain, and how can I get it to show the name only not the ID number as well? Otherwise, this works great, thank you!

amoverton2 · Aug 23, 2021

Also, I've been playing around with the new code.

When I try to add someone, via the RATE/LAST,FIRST NAME/CELL/EMAIL (where there is no prospective gain) by putting in all of those values, when I click Update it only takes the first one, Rate.
It also shrinks the original listbox.

Then I go back in and click the RATE I just put in, and it still doesn't allow me to input any of the other values (LAST,FIRST NAME/CELL/EMAIL) and shrinks the listbox

dmt32 · Aug 23, 2021

txtSearch is coded to right align with the end of lstDatabase Listbox.
If you want to change alignment you need to either change the Left value of the txtSearch control shown in BOLD to your required alignment value or Delete the line and place the control where you want it manually.

Rich (BB code):

With SearchBox
        .Top = Me.TextBox1.Top
        .Width = SearchBoxWidth
        .Left = Me.lstDatabase.Left - (.Width - Me.lstDatabase.Width)
    End With

To hide first Column in Listbox1 (search listbox) Change the ColumnWdth value to 0 (Zero)

Rich (BB code):

With Me.ListBox1
        .Width = SearchBox.Width + (SearchBox.Width) / 2 '196
        .Left = SearchBox.Left - (SearchBox.Width) / 2
        .Top = SearchBox.Top + SearchBox.Height + 1
        .SpecialEffect = fmSpecialEffectFlat
        .ColumnCount = 2
        .ColumnWidths = "0 pt;100 pt"
        .Visible = False
    End With

Dave

dmt32 · Aug 23, 2021

amoverton2 said:
Also, I've been playing around with the new code.

When I try to add someone, via the RATE/LAST,FIRST NAME/CELL/EMAIL (where there is no prospective gain) by putting in all of those values, when I click Update it only takes the first one, Rate.
It also shrinks the original listbox.

Then I go back in and click the RATE I just put in, and it still doesn't allow me to input any of the other values (LAST,FIRST NAME/CELL/EMAIL) and shrinks the listbox

Code I provided just selects values in you listbox I have not altered your original data entry / edit code.
Suggest check what's happening on your backup copy

amoverton2 · Aug 23, 2021

dmt32 said:
Code I provided just selects values in you listbox I have not altered your original data entry / edit code.
Suggest check what's happening on your backup copy

Will do... one other quick question, the box that pops up when I input a name, how do I modify the size of it so it's not so tall?

dmt32 · Aug 23, 2021

amoverton2 said:
Will do... one other quick question, the box that pops up when I input a name, how do I modify the size of it so it's not so tall?

You can set Min / Max Height in the SearchRecords code

Rich (BB code):

Sub SearchRecords(ByVal Form As Object, sh As Object, ByVal Search As String)
    Dim i               As Long
    Dim arr             As Variant
    Const ListBoxMinHeight As Integer = 70, ListBoxMaxHeight As Integer = 250

Adjust values as required

Dave

Partial Match VBA - Search Button

amoverton2

Board Regular

dmt32

Well-known Member

amoverton2

Board Regular

dmt32

Well-known Member

amoverton2

Board Regular

amoverton2

Board Regular

dmt32

Well-known Member

dmt32

Well-known Member

amoverton2

Board Regular

dmt32

Well-known Member

Similar threads

Forum statistics

Share this page

Partial Match VBA - Search Button

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Board Regular

Well-known Member

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock