CODEWITHSUNDEEP
vbaexcellistboxuserform
Alba1970
Alba1970

Reputation: 3

Populating a ListBox from search criteria entered into a TextBox in Excel VBA

I have posted this problem before, however, I think it was overly complicated and I didn’t explain it very well. This time I am just using a simple UserForm as an example.

I want to populate a ListBox by entering search criteria in a Textbox.

I have three columns:

Column A = Library Card Number

Column B = Pupil Name

Column C = Book Reference

I have a UserForm:

TextBox = txtlcn (for the Library Card Number)

TextBox = txtpn (for the Pupil Name)

TextBox = txtbr (for the Book Reference)

Command Button = cmdfinddetails (Find Details)

What I want to do is change the TextBox ‘txtbr’ into a ListBox, so that I can see if a pupil has more than one book loaned out to them. The process would be:

  1. A pupil enters their Library Card Number in TextBox ‘txtlcn’ and clicks on Command Button ‘cmdfinddetails’
  2. The code will search for that Pupil’s name and all the book references booked out to them.
  3. The book reference(s) will be displayed in a ListBox.

I have tried lots of things to do with RowSource but it always lists every pupil’s book reference. Below is my sample code.

Private Sub cmdfinddetails_Click()
Set xSht = Sheets("Library")
        Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row
        strSearch = txtlcn.Text
                    Set aCell = xSht.Range("A1:A" & Lastrow).Find

(What:=strSearch, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

      If Not aCell Is Nothing And txtpn.Value = "" Then
         GoTo libcardrefvalid      
     Else
MsgBox "Oops! That Library Card does not exist. Please try again.", Title:="We LOVE Reading ;-)"
txtlcn.Value = ""
        End If
    Exit Sub
libcardrefvalid:

row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("Library").Range("A" & row_number)
If item_in_review = txtlcn.Text Then
txtpn.Text = Sheets("Library").Range("B" & row_number)
txtbr.Text = Sheets("Library").Range("C" & row_number)
End If
Loop Until item_in_review = ""

End Sub

Any help would be greatly appreciated.

Thank you.

Upvotes: 0

Views: 8505

Answers (1)

USFBS
USFBS

Reputation: 279

Assuming that you have already changed txtbr to a listbox, I was able to get your code working (looking up pupil name and adding all books referenced to the txtbr listbox) with the following additions:

Private Sub CommandButton1_Click()
'clears the pupil name (caused an error if not done)
txtpn.Text = ""
Set xSht = Sheets("Library")
        Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row
        strSearch = txtlcn.Text
                    Set aCell = xSht.Range("A1:A" & Lastrow).Find(What:=strSearch, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

      If Not aCell Is Nothing And txtpn.Value = "" Then
         GoTo libcardrefvalid
     Else
MsgBox "Oops! That Library Card does not exist. Please try again.", Title:="We LOVE Reading ;-)"
txtlcn.Value = ""
        End If
    Exit Sub
libcardrefvalid:

row_number = 0
'clears the listbox so that you have dont have a continuously growing list
txtbr.Clear
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("Library").Range("A" & row_number)
If item_in_review = txtlcn.Text Then
txtpn.Text = Sheets("Library").Range("B" & row_number)
'Adds the book reference number to the list box
txtbr.AddItem Sheets("Library").Range("C" & row_number)
End If
Loop Until item_in_review = ""
End Sub

I made a test userform and some mock up data and this worked for me. Hopefully you find it does so for you as well.

Upvotes: 2

Related Questions