Filter listbox

[charly1]

Hi all

In a previous inquiry I was shown how to create a user form with a dynamic filter, to populate a list box based on data entered into a separate textbox.

I need though for the list box to be multicolumn, displaying the data from multiple columns in the source table, not just the cells that match the data in the textbox.

I cant seem to get my head around the code though, and if anyone out there is able to help me, it would be greatly appreciated.
please find link of current user form attached.

Book1.xlsm

Sheet1 one,two,three 1,Monday1,Monday 2,Tuesday2,Tuesday 3,Wednesday3,Wednesday 4,Thursday4,Thursday 5,Friday5,Friday 6,Saturday6,Saturday 7,Sunday7,Sunday 8,Monday8,Monday 9,Tuesday9,Tuesday 10,Wednesday10,Wednesday 11,Thursday11,Thursday 12,Friday12,Friday 13,Saturday13,Saturday 14,Sunday14,Su...

docs.google.com

 

[Fluff]

The only one that should cause a problem is the ".
Try

Private Sub TextBox1_Change()
   Dim Ary As Variant, Rws As Variant
   Dim TBVal As String
   Dim Ws As Worksheet
   
   
   Set Ws = Sheets("Sheet1")
   TBVal = TextBox1.Value
   With Ws.ListObjects("Table1").DataBodyRange
      If TBVal = "" Then
         Ary = Evaluate("choosecols(" & .Address & ",14, 7, 5, 2, 3, 4)")
      Else
         TBVal = Replace(TBVal, Chr(34), Chr(34) & Chr(34))
         Rws = Filter(Evaluate(Replace("transpose(if(isnumber(search(""" & TBVal & """,@)),row(@)-min(row(@))+1,""X""))", "@", .Columns(14).Address)), "X", False)
         If UBound(Rws) < 0 Then
            Me.ListBox1.List = Array("No matches")
            Exit Sub
         ElseIf UBound(Rws) = 0 Then
            ReDim Preserve Rws(1)
         End If
         Ary = Application.Index(.Value, Application.Transpose(Rws), Array(14, 5, 7, 2, 3, 4))
      End If
   End With
   With Me.ListBox1
      .ColumnCount = UBound(Ary, 2)
      .List = Ary
   End With
End Sub

 

[charly1]

The only one that should cause a problem is the ".
Try

Private Sub TextBox1_Change()
   Dim Ary As Variant, Rws As Variant
   Dim TBVal As String
   Dim Ws As Worksheet
  
  
   Set Ws = Sheets("Sheet1")
   TBVal = TextBox1.Value
   With Ws.ListObjects("Table1").DataBodyRange
      If TBVal = "" Then
         Ary = Evaluate("choosecols(" & .Address & ",14, 7, 5, 2, 3, 4)")
      Else
         TBVal = Replace(TBVal, Chr(34), Chr(34) & Chr(34))
         Rws = Filter(Evaluate(Replace("transpose(if(isnumber(search(""" & TBVal & """,@)),row(@)-min(row(@))+1,""X""))", "@", .Columns(14).Address)), "X", False)
         If UBound(Rws) < 0 Then
            Me.ListBox1.List = Array("No matches")
            Exit Sub
         ElseIf UBound(Rws) = 0 Then
            ReDim Preserve Rws(1)
         End If
         Ary = Application.Index(.Value, Application.Transpose(Rws), Array(14, 5, 7, 2, 3, 4))
      End If
   End With
   With Me.ListBox1
      .ColumnCount = UBound(Ary, 2)
      .List = Ary
   End With
End Sub

It works Perfectly!

Thanks a mil. You've helped save me hours of work.

 

[Fluff]

You're welcome & thanks for the feedback.