VBA Userform live search userform with listbox

[jsneak84]

Hi everyone,

I'm currently in the process of getting the workings right for a trailer movement userform that I've had an idea about.

I've got the stage where the form changes when searching but i can't figure out how to populate the columns with the array (Within the listbox - it has 16 columns) Currently it just shows 1 column

Private Sub TextBox14_Change()
    Dim i As Long
    Dim arrList As Variant
    ListBox1.RowSource = ""

    If Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row > 1 And Trim(Me.TextBox14.Value) <> vbNullString Then
        arrList = Sheet1.Range("A2:Q" & Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row).Value2
        For i = LBound(arrList) To UBound(arrList)
            If InStr(1, arrList(i, 1), Trim(Me.TextBox14.Value), vbTextCompare) Then
                Me.ListBox1.AddItem arrList(i, 1)
            End If
        Next i
    End If
    If Me.ListBox1.ListCount = 1 Then Me.ListBox1.Selected(0) = True
End Sub

So if you search BAY117 - it will list 3 of them (which is correct) Each one has different data, that is saved with the array but i'm not sure how i go about listing that data next to each data entry

Any help on this would be great

Thanks in advance!

EDIT:
Also posted here VBA Live search box in userform with listbox

 

[GWteB]

You're looking for something like this I think. Be sure to put the Option Base 1 statement at the top in the Userform module. The function OwnReDimPreserve can be placed in either the Userform module or a regular module; when placed in a regular module the Option Base 1 statement is also required. The cColumns constant can be changed according to your needs.

Option Base 1

Private Sub TextBox14_Change()

    Const cColumns  As Integer = 16
    Dim i           As Long
    Dim x           As Long
    Dim arrSource   As Variant
    Dim arrResult() As Variant

    x = 1
    ReDim arrResult(1, cColumns)
    ListBox1.RowSource = ""

    If Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row > 1 And Trim(Me.TextBox14.Value) <> vbNullString Then
        arrSource = Sheet1.Range("A2:Q" & Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row).Value2
        For i = LBound(arrSource) To UBound(arrSource)
            If InStr(1, arrSource(i, 1), Trim(Me.TextBox14.Value), vbTextCompare) Then
                If IsEmpty(arrResult(1, 1)) And UBound(arrResult()) = 1 Then
                    ' do nothing
                Else
                    arrResult = OwnReDimPreserve(arrResult, UBound(arrResult()) + 1, cColumns)
                End If
                For n = 1 To cColumns
                    arrResult(x, n) = arrSource(i, n)
                Next n
                x = x + 1
            End If
        Next i
    End If
    Me.ListBox1.List = arrResult
    If Me.ListBox1.ListCount = 1 Then Me.ListBox1.Selected(0) = True
End Sub

Public Function OwnReDimPreserve(ByRef argArray, ByVal argIndex1 As Integer, ByVal argIndex2 As Integer) As Variant()

    Dim arrTemp()   As Variant
    Dim x           As Integer
    Dim y           As Integer

    ReDim arrTemp(argIndex1, argIndex2)

    For x = 1 To UBound(argArray, 1)
        For y = 1 To UBound(argArray, 2)
            arrTemp(x, y) = argArray(x, y)
        Next
    Next
    OwnReDimPreserve = arrTemp
End Function

 

[jsneak84]

GWteB, you are a legend. That is indeed working like a charm!

Is there a way of formatting the 4th/5th "y" as "dd/mm/yyyy hh:mm"?

Thanks again for your help!

 

[GWteB]

You're welcome & thanks for letting me know. Glad it works for you.

Is there a way of formatting the 4th/5th "y" as "dd/mm/yyyy hh:mm"?

That needs another approach. Make a copy of your worksheet and rename the copy to "shtUsfList". The code below now will use that sheet as the source for your list box. Your list box will display the data according to the formatting of your worksheet, so date and time will be displayed appropriate. For testing purposes make sheet "shtUsfList" the active sheet when launching the UserForm so you're able to see what's going on. When preferred you can make the sheet "shtUsfList" hidden afterwards.

Private Sub TextBox14_Change()

    Const cColumns      As Integer = 16
    Const cMyListSheet  As String = "shtUsfList"
    Dim i               As Long
    Dim x               As Long
    Dim arrSource       As Variant
    Dim arrResult()     As Variant
    Dim raList          As Range

    x = 1
    ReDim arrResult(1, cColumns)

    If Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row > 1 And Trim(Me.TextBox14.Value) <> vbNullString Then
        arrSource = Sheet1.Range("A2:Q" & Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row).Value2
        For i = LBound(arrSource) To UBound(arrSource)
            If InStr(1, arrSource(i, 1), Trim(Me.TextBox14.Value), vbTextCompare) Then
                If IsEmpty(arrResult(1, 1)) And UBound(arrResult()) = 1 Then
                    ' do nothing
                Else
                    arrResult = OwnReDimPreserve(arrResult, UBound(arrResult()) + 1, cColumns)
                End If
                For n = 1 To cColumns
                    arrResult(x, n) = arrSource(i, n)
                Next n
                x = x + 1
            End If
        Next i
    End If
'    Me.ListBox1.List = arrResult   ' <<< not needed anymore

    With ThisWorkbook.Sheets(cMyListSheet)
        Set raList = .Range(.Cells(1, 1), .Cells(UBound(arrResult, 1), UBound(arrResult, 2)))
    End With
    raList = arrResult
    Me.ListBox1.RowSource = raList.Parent.Name & "!" & raList.Address
    
    If Me.ListBox1.ListCount = 1 And raList.Formula(1, 1) <> "" Then
        Me.ListBox1.Selected(0) = True
    End If
    Set raList = Nothing
End Sub

 

[jsneak84]

Hi GWteB,

Thank you again for your support with this, it's a lot more complicated than originally thought it was going to be!

Would it be an idea that when the form loads, it pastes the data across onto that new sheet each time? I've not really started putting the data in a good format yet, i was just seeing if i could get it all working first. My idea was going to be that the user could add and move trailers around a lot more easy than the current method - which I've not implemented yet so the data would change all the time.

 

[GWteB]

You are welcome.
When the UserForm launches on default the list box is empty (as far as I can see; haven't seen the rest of your code of the UserForm). When the text box changes, the line of code
arrSource = Sheet1.Range("A2:Q" & Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row).Value2
reads the given range into the 2 dimensional matrix variable "arrSource". Within this variable the search is taken place for whatever is in that text box; searching within memory is much more faster than searching within a range on a worksheet. The result of the search is put in the variable "arrResult" which finally is copied to the extra worksheet. With this approach there is one important condition that you must take into account: the (filtered) items are always placed starting in the first column (of the first row) on the extra sheet. In your current situation the source data begins in column "A" (also first column) so no problems. However, when source data starts in another column the data for displaying in the list box will be shifted to the left so formatting of date and time will be lost.

Would it be an idea that when the form loads, it pastes the data across onto that new sheet each time?

My advise to copy your data sheet was regarding the formatting of each column (eg. dd/mm/yyyy). Copying an entire worksheet is faster than adding a new one and pasting data onto the new sheet. It can easily be done in the UserForm_Initialize() event routine. When the UserForm unloads (UserForm_Terminate()) that sheet can be deleted so you never end up with unnecessary duplicates.

 

[jsneak84]

Thanks again for your reply,

Currently on the form i have 4 ComboBoxes that populate when it initializes. Below is the code i wrote. Would i add the copy of the worksheet into a new sheet on this part?

Private Sub UserForm_Initialize()
    Dim bays As Range, wType As Range, sType As Range, Ans As Range
    Dim ws As Worksheet
    ListBox1.IntegralHeight = False
    Label21.Caption = ""
    
    Set ws = Worksheets("lists")
        For Each bays In ws.Range("Bay_list")
            Me.ComboBox1.AddItem bays.Value
    Next bays
    
        For Each wType In ws.Range("type_list")
            Me.ComboBox2.AddItem wType.Value
    Next wType
    
        For Each sType In ws.Range("Supplier_list")
            Me.ComboBox3.AddItem sType.Value
    Next sType
    
        For Each Ans In ws.Range("ans_list")
            Me.ComboBox4.AddItem Ans.Value
    Next Ans
End Sub

Yet again, thank you for your help

 

[GWteB]

You're welcome! First a comment. You are populating the combo boxes each in a FOR...EACH...NEXT loop. Nothing wrong with that but it's more efficient to do it in one statement, especially since you are using named ranges. Below an example. When you're using multi column boxes be sure the source on your worksheet looks accordingly.

    Set ws = Worksheets("lists")
    With ws
        Me.ComboBox1.List = .Range("Bay_list")
        Me.ComboBox2.List = .Range("type_list")
        Me.ComboBox3.List = .Range("Supplier_list")
        Me.ComboBox4.List = .Range("ans_list")
    End With

You even might consider to populate those boxes automatically when your userform loads. This can be done during design time. Select combo box > press F4 for properties window > fill in the name of desired range at property RowSource > done; named range must already be defined otherwise it will not be accepted and an error message pops up.

As you see there are much more properties which can be modified. Good practice is to rename your controls. Names that provide insight say more than just numbers.

Would i add the copy of the worksheet into a new sheet on this part?

That is correct but it's important to keep track of the new made copy, in order to be able to delete that copy when the UserForm is closed. That can be done by declaring a variable with scope in the whole module, regardless off which sub in that module is running (or none, cause the UserForm is waiting for user input...). That scope will remain until your UserForm terminates. In the below code the variable modWsTmp has that scope. Finally, because of these changes my post #4 code had to be adjusted for the listbox to work. Enjoy and success with your project!

Option Base 1

Private modWsTmp     As Worksheet    ' <<<<<<<<< ref to copy of list sheet


Private Sub UserForm_Initialize()

    ListBox1.IntegralHeight = False
    Label21.Caption = ""

    ' copy list sheet to a new (unsaved) workbook which is automatically activated
    Sheet1.Copy
    ' make proper reference with scope during run-time of this UserForm
    Set modWsTmp = ActiveSheet
    ' prevent accidental closing > so hide window & remove button from taskbar
    modWsTmp.Parent.Parent.ActiveWindow.Visible = False

    ' populate combo boxes as desired
    Set ws = ThisWorkbook.Worksheets("lists")
    With ws
        Me.ComboBox1.List = .Range("Bay_list")
        Me.ComboBox2.List = .Range("type_list")
        Me.ComboBox3.List = .Range("Supplier_list")
        Me.ComboBox4.List = .Range("ans_list")
    End With

End Sub


Private Sub UserForm_Terminate()

    ' close the new (unsaved) workbook and prevent/ignore warning
    modWsTmp.Parent.Close SaveChanges:=False
    ' clean up
    Set modWsTmp = Nothing
  
End Sub


Private Sub TextBox14_Change()

    Const cColumns             As Integer = 16
    Const cHeadingsRowCount    As Integer = 1

    Dim i               As Long
    Dim x               As Long
    Dim arrSource       As Variant
    Dim arrResult()     As Variant
    Dim raList          As Range

    x = 1
    ReDim arrResult(1, cColumns)

    If Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row > 1 And Trim(Me.TextBox14.Value) <> vbNullString Then
        arrSource = Sheet1.Range("A2:Q" & Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row).Value2
        For i = LBound(arrSource) To UBound(arrSource)
            If InStr(1, arrSource(i, 1), Trim(Me.TextBox14.Value), vbTextCompare) Then
                If IsEmpty(arrResult(1, 1)) And UBound(arrResult()) = 1 Then
                    ' do nothing
                Else
                    arrResult = OwnReDimPreserve(arrResult, UBound(arrResult()) + 1, cColumns)
                End If
                For n = 1 To cColumns
                    arrResult(x, n) = arrSource(i, n)
                Next n
                x = x + 1
            End If
        Next i
    End If

    With modWsTmp
        Set raList = .Range(.Cells(1 + cHeadingsRowCount, 1), _
                            .Cells(UBound(arrResult, 1) + cHeadingsRowCount, UBound(arrResult, 2)))
    End With
    raList = arrResult
    Me.ListBox1.RowSource = "[" & raList.Parent.Parent.Name & "]" & raList.Parent.Name & "!" & raList.Address

    If Me.ListBox1.ListCount = 1 And raList.Formula(1, 1) <> "" Then
        Me.ListBox1.Selected(0) = True
    End If
    Set raList = Nothing
End Sub

 

[jsneak84]

GWteB,

Can't thank you enough mate, thank you for all your help