Filter Only matching results in ListBox Excel from TextBox text - vba

I have a user form with a textbox and a listbox. I would like a user to be able to enter text into the textbox, and have the listbox filter results based on their typing.
So far, I have managed to get the ListBox to highlight matching results in the list, but not filter out results that dont match. I have also run into the issue of my code not identifying multiple matching records, not sure what I need to add to get this to happen.
Private Sub TextBox3_Change()
'searches ListBox3 for match and hightlights result. Need to filter results.
Dim i As Long
Dim sFind As String
sFind = Me.TextBox3.Text
If Len(sFind) = 0 Then
Me.ListBox3.ListIndex = -1
Me.ListBox3.TopIndex = 0
Else
For i = 0 To Me.ListBox3.ListCount - 1
If UCase(Left(Me.ListBox3.List(i), Len(sFind))) = UCase(sFind) Then
Me.ListBox3.TopIndex = i
Me.ListBox3.ListIndex = i
Exit For
End If
Next i
End If
End Sub

Try using this code that works when you exit textbox3, otherwise it will make some filtering while typing and can bring errors.
If the match is exact
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
For i = ListBox1.ListCount - 1 To 0 Step -1
If Not ListBox1.List(i) = TextBox3 Then ListBox1.RemoveItem (i)
Next i
End Sub
And the loop is made with a recursive loop, otherwise an error appear.
For partial matches
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
For i = ListBox1.ListCount - 1 To 0 Step -1
If InStr(1, ListBox1.List(i), TextBox3) = 0 Then ListBox1.RemoveItem (i)
Next i
End Sub
Found a better code to filter a listbox.

Related

How to use function to prevent duplicated record for datagridview

I use function to prevent the same record goes into my datagridview but it doesnt work , when i separate the code out then its worked
i tried to seperate the for loop part out then the code work , but i wan to use function to do it so the code look more neater
Private Sub PicFavNote10_Click(sender As Object, e As EventArgs) Handles picFavNote10.Click
If validationDataGrid(lblNameNote10.Text) <> True Then
'if item didn added to the favorite data table yet
'add to favorite table
addTofavorite(lblUserLogin.Text, lblNameNote10.Text, lblDecpNote10.Text, txtPicNote10.Text, "SmartPhone", lblPriceNote10.Text)
End If
lblPriceNote10.Text = FormatCurrency(lblPriceNote10.Text)
End Sub
Private Function validationDataGrid(ByRef data As String) As Boolean
'validation on data grid view
For Each itm As DataGridViewRow In DGTFavTable.Rows 'loop though every item in datagrid
If itm.Cells(0).Value = data Then 'check wherter the text already exist
MsgBox(data & " Already added to your favorite cart")
Return True
Else
Return False
End If
Next
End Function
I expected the MsgBox(data & " Already added to your favorite cart") will excecute but instead the validationDataGrid function return false value even the item is already added to favorite datagridview
Before you loop all rows you need to call this sub as is an efficient workaround to validate new data on DataGridView:
Private Sub ForceGridValidation()
'Get the current cell
Dim currentCell As DataGridViewCell = DGTFavTable.CurrentCell
If currentCell IsNot Nothing Then
Dim colIndex As Integer = currentCell.ColumnIndex
If colIndex < DGTFavTable.Columns.Count - 1 Then
DGTFavTable.CurrentCell = DGTFavTable.Item(colIndex + 1, currentCell.RowIndex)
ElseIf colIndex > 1 Then
DGTFavTable.CurrentCell = DGTFavTable.Item(colIndex - 1, currentCell.RowIndex)
End If
'Set the original cell
DGTFavTable.CurrentCell = currentCell
End If
End Sub

2 Listboxes into 1 and then delete matching values VBA

I want to have 2 listboxes, 1 with a bunch of values and one with another bunch of values, I want to add them to a 3rd listbox and then delete all of the matching values,
here is my code i have got so far,
For i = 0 To (ListBox1.ListCount - 1)
ListBox3.AddItem (ListBox1.List(i))
Next
Dim qstring As String
For i = 0 To (ListBox2.ListCount - 1)
qstring = ListBox1.List(i)
With Me.ListBox3
'Loop through combobox
For b = 0 To .ListCount - 1
If .List(b) = qstring Then
strFound = True
Exit For
End If
Next b
'Check if we should add item
If Not strFound Then .AddItem (qstring)
End With
Next
Revised, Thank you for your help sir, I am now wondering why I am receiving this error, Thank you!
Error
You can use a Scripting.Dictionary object which allows unique Keys. You can check if an item exist using the .Exists method.
Sub Whatever()
Dim obj As Object
Set obj = CreateObject("Scripting.Dictionary")
'1st ListBox
For i = 0 To ListBox1.ListCount - 1
If Not obj.Exists(CStr(ListBox1.List(i))) Then
obj.Add CStr(ListBox1.List(i)), vbNullString
End If
Next
'2nd ListBox
For i = 0 To ListBox2.ListCount - 1
If Not obj.Exists(CStr(ListBox2.List(i))) Then
obj.Add ListBox2.List(i), vbNullString
End If
Next
'add unique list to 3rd ListBox
Dim Key As Variant
For Each Key In obj.Keys
ListBox3.AddItem Key
Next Key
End Sub
Edit:
Credit to #Nathan_Sav for pointing this out. No need to loop to fill the 3rd ListBox.
ListBox3.List = obj.Keys()

How do I prevent ListBox - Multiselect Change Event from firing twice on the first selection?

I have created a UserForm that has two ListBoxes, one populated from a dictionary that contains excess items from a company report, and the other from a dictionary that contains excess items from a bank report. The first ListBox is a fmMultiSelectMulti, allowing the user to select multiple items to get the sum of the selected items (which change the value of a TextBox).
My issue is when I select the first item in the ListBox, the ListBox_Change() event fires twice. The sum variable is public since it is referenced in other methods, but upon the double-fire, it doubles the real value.
Here's the code for the change event:
Private Sub GPListBox_Change()
For lItem = 0 To GPListBox.ListCount - 1
If GPListBox.Selected(lItem) = True Then
gpTotal = gpTotal + GPListBox.List(lItem, 1)
Debug.Print GPListBox.List(lItem, 1)
End If
Next
GPTotalTextBox.Value = Format(gpTotal, "$#,##0.00")
End Sub
The other method that removes the (multiple) selected variables, and references the sum variable:
Private Sub RemoveButton1_Click()
For lItem = GPListBox.ListCount - 1 To 0 Step -1
If GPListBox.Selected(lItem) Then
gpTotal = gpTotal - GPListBox.List(lItem, 1)
'GPListBox.RemoveItem GPListBox.ListIndex
GPListBox.RemoveItem lItem
GPTotalTextBox.Value = gpTotal
End If
Next
End Sub
This is the UserForm after I selected the first item, which automatically deselected and left the sum present:
.
My Question: How do I prevent this from double-firing every time the first selection occurs?
I have got around it like this in the past. Something like this.
Use a global boolean at the top of you code. Above all subs and functions.
Dim bFire as Boolean
A boolean is false by default so you will have to set the boolean to true somewhere outside of you subs such as form UserForm_Initialize event or something. If you don't have a place to do that, switch the true/false usage in the subs (Benno Grimm Elaborated on this below in comments).
Private Sub UserForm_Initialize()
bFire = True
End Sub
Then use the boolean in the subs.
Private Sub GPListBox_Change()
'Check the status and get out if you have set it to not fire.
If bFire = false then
Exit Sub
End If
For lItem = 0 To GPListBox.ListCount - 1
If GPListBox.Selected(lItem) = True Then
gpTotal = gpTotal + GPListBox.List(lItem, 1)
Debug.Print GPListBox.List(lItem, 1)
End If
Next
GPTotalTextBox.Value = Format(gpTotal, "$#,##0.00")
End Sub
In the button that modifies it, set the boolean false at the start and true at the end.
Private Sub RemoveButton1_Click()
'Set it false
bFire = false
For lItem = GPListBox.ListCount - 1 To 0 Step -1
If GPListBox.Selected(lItem) Then
gpTotal = gpTotal - GPListBox.List(lItem, 1)
'GPListBox.RemoveItem GPListBox.ListIndex
GPListBox.RemoveItem lItem
GPTotalTextBox.Value = gpTotal
End If
Next
'After you have modified the control set it to true
bFire = True
End Sub

Creating comboboxes in loop VBA

Hey guys I want to create a certain amount of combo boxes when a commandbutton is pressed. I cant figure out how to do it so I will really appreciate your help. This is the code ive created:
Private Sub CommandButton1_Click()
Dim AttPoints As Integer, Result As String
Range("E1:Z4").ClearContents
AttPoints = Range("B2").Value
If AttPoints = 0 Then
Result = "You have selected 0 AttPoints!"
ElseIf AttPoints < 0 Then
Result = "You have selected a negative amount of AttPoints!"
ElseIf AttPoints > 0 Then
Dim i As Integer
For i = 5 To (AttPoints + 4)
Cells(1, i).Value = "Attachment point:" & (i - 4)
Next i
End If
Range("A1") = Result
End Sub
In the for loop I create a row of cells in which the text attachment point is placed.
Under these texts i want the same amount of comboboxes as can be seen in the picture.
Add the following bit of code inside your loop
Private Sub CommandButton1_Click()
...
Shapes.AddOLEObject ClassType:="Forms.Combobox.1", _
Left:=Cells(2, i).Left, Top:=Cells(2, i).Top, _
Width:=Cells(2, i).Width, Height:=Cells(2, i).Height * 2
...
End Sub
That should produce your desired result.

How to search in listview

I am trying to create a Loop that will read through the information on my ListView through the SubItem to find the text that matches the text in my Textbox whenever I hit the search button and Focuses the listbox onto the matched text. Below is what I have but it keeps telling me that the value of string cannot be converted. I am also pretty sure that my numbers wont loop correctly but I am not really sure how to cause them to loop endlessly till end of statement.
Dim T As String
T = Lines.Text
For r As Integer = 0 to -1
For C As Integer = 0 to -1
If List.Items(r).SubItems(C).Text = Lines.Text Then
List.FocusedItem = T
End If
Next
Next
End Sub
I don't understand your code, but I do understand the question. Below is example code to search all rows and columns of a listview. Search is case insensitive and supports a "find next match" scenario. If a match or partial match is found in any column the row is selected. TextBox1 gets the text to find. FindBtn starts a new search.
Private SrchParameter As String = ""
Private NxtStrtRow As Integer = 0
Private Sub FindBtn_Click(sender As Object, e As EventArgs) Handles FindBtn.Click
If Not String.IsNullOrWhiteSpace(TextBox1.Text) Then
SrchParameter = TextBox1.Text
NxtStrtRow = 0
SearchListView()
End If
End Sub
Private Sub ListView1_KeyDown(sender As Object, e As KeyEventArgs) Handles ListView1.KeyDown
If e.KeyCode = Keys.F3 Then
SearchListView()
End If
End Sub
Private Sub SearchListView()
' selects the row containing data matching the text parameter
' sets NxtStrtRow (a form level variable) value for a "find next match" scenario (press F3 key)
If ListView1.Items.Count > 0 Then
If SrchParameter <> "" Then
Dim thisRow As Integer = -1
For x As Integer = NxtStrtRow To ListView1.Items.Count - 1 ' each row
For y As Integer = 0 To ListView1.Columns.Count - 1 ' each column
If InStr(1, ListView1.Items(x).SubItems(y).Text.ToLower, SrchParameter.ToLower) > 0 Then
thisRow = x
NxtStrtRow = x + 1
Exit For
End If
Next
If thisRow > -1 Then Exit For
Next
If thisRow = -1 Then
MsgBox("Not found.")
NxtStrtRow = 0
TextBox1.SelectAll()
TextBox1.Select()
Else
' select the row, ensure its visible and set focus into the listview
ListView1.Items(thisRow).Selected = True
ListView1.Items(thisRow).EnsureVisible()
ListView1.Select()
End If
End If
End If
End Sub
Instead of looping like that through the ListView, try using a For Each instead:
searchstring as String = "test1b"
ListView1.SelectedIndices.Clear()
For Each lvi As ListViewItem In ListView1.Items
For Each lvisub As ListViewItem.ListViewSubItem In lvi.SubItems
If lvisub.Text = searchstring Then
ListView1.SelectedIndices.Add(lvi.Index)
Exit For
End If
Next
Next
ListView1.Focus()
This will select every item which has a text match in a subitem.
Don't put this code in a form load handler, it won't give the focus to the listview and the selected items won't show. Use a Button click handler instead.
This is the easiest way to search in listview and combobox controls in vb net
dim i as integer = cb_name.findstring(tb_name.text) 'findstring will return index
if i = -1 then
msgbox("Not found")
else
msgbox("Item found")
end if