How to export filtered listbox contents into an excel file?

[Waimea]

I am using an userform with a listbox and I want to export the filtered listbox contents into an excel file.

myarray = Sheet61.ListObjects("Data").DataBodyRange.Value


With ListBox1
.List = myarray
.ColumnCount = 25
.ColumnHeads = False
End With

This code loads the DataBodyRange.Value into my listbox. I then filter it using the following code:

Private Sub TextBox1_Change()Application.ScreenUpdating = False
    
    Dim endarr(), ListEndRow As Long, lrows As Long, i As Long, j As Long, k As Long
    If TextBox1.Text = vbNullString Then ListBox1.List = myarray: Exit Sub
                
    ListEndRow = 1
    With Sheet61
        lrows = .ListObjects("Data").DataBodyRange.Rows.Count
        ReDim endarr(1 To lrows, 1 To 21)
        For i = 1 To UBound(myarray)
            If Left(LCase(myarray(i, 5)), LCase(Len(TextBox1.Text))) = LCase(TextBox1.Text) Then
                For j = 1 To 20
                    endarr(ListEndRow, j) = myarray(i, j)
                Next
                ListEndRow = ListEndRow + 1
            End If
        Next
    End With
    ListBox1.List = endarr
    
    Me.TextBox1.BackColor = RGB(231, 125, 0)
    Application.ScreenUpdating = True
End Sub

1. Where should I start to export the filtered listbox to an excel file?

2. How can I edit things in the array? Or should I edit the databodyrange and then reload the array?

 

[Waimea]

Hi Fluff,

thank you for your reply and I think I understand what you mean.

Dim endarr()
Dim endarr2()

I am declaring two arrays at the top.

Private Sub TextBox1_Change()
    
    Dim ListEndRow As Long, lrows As Long, i As Long, j As Long, k As Long
    If TextBox1.Text = vbNullString Then ListBox1.List = Myarray: Exit Sub
                
    ListEndRow = 1
    With Sheet61
        lrows = .ListObjects("Data").DataBodyRange.Rows.Count
        ReDim endarr2(1 To lrows, 1 To 21)

        For i = 1 To UBound(Myarray)
        If Left(LCase(Myarray(i, 5)), LCase(Len(TextBox1.Text))) = LCase(TextBox1.Text) Then
                  
                For j = 1 To 20
                   endarr(ListEndRow, j) = endarr2(i, j)
                Next
                ListEndRow = ListEndRow + 1
            End If
        Next
    End With
    ListBox1.List = endarr2


End Sub

        For i = 1 To UBound(Myarray)
        If Left(LCase(Myarray(i, 5)), LCase(Len(TextBox1.Text))) = LCase(TextBox1.Text) Then

Is this the part where I change Myarray to endarr?

 

[Fluff]

Change this 

If TextBox1.Text = vbNullString Then ListBox1.List = MyArray: Exit Sub

to

If TextBox1.Text = vbNullString Then
   ListBox1.List = MyArray
   Exit Sub
Else
   MyArray = ListBox1.List
End If

 

[Waimea]

Hi Fluff,

thank you for your help!

I still can't get it to work. I will try something else for a while and then come back to it!

 

[Waimea]

Hi again,

I have tried for several hours now without success.

I don't get how to filter the listbox with textbox1 and then filter the filtered listbox again with textbox2 etc. to textbox4.

Could you give me a tip?

 

[Fluff]

I have tried for several hours now without success.

Or do you mean that you have asked an almost identical question elsewhere & have had no response?

 

[Waimea]

Hi,

thank you for your reply and you are correct Fluff,

I posted a similar question about Listbox and ComboBoxes here https://www.excelforum.com/excel-pr...-how-to-filter-a-listbox-with-comboboxes.html

I though about mentioning that I crossposted but I though they were kind of different since one is about TextBoxes and the other is about ComboBoxes.


I have googled alot and I found this thread: https://www.excelforum.com/excel-pr...g-combobox-on-userform-to-filter-listbox.html

And with trying I have tried merging the two different codes I have and trying to understand the code in the above mentioned thread.

 

[Fluff]

Whilst I am more than happy to help, I consider it very rude when an op starts crossposting, when I am trying to help.
I would advise you to not do that again.

That said try something like

Private Sub TextBox2_Change()
   Dim MyArray As Variant, EndArray As Variant
   Dim i As Long, j As Long, Rw As Long
   
   If TextBox2.Text = vbNullString Then Exit Sub
   MyArray = Me.ListBox1.List
   
   ReDim EndArray(0 To UBound(MyArray), 0 To 20)
   
   For i = 0 To UBound(MyArray)
      If LCase(MyArray(i, 8)) Like LCase(TextBox2.Text) & "*" Then
         For j = 0 To 20
            EndArray(Rw, j) = MyArray(i, j)
         Next
         Rw = Rw + 1
      End If
   Next
   ListBox1.List = Application.Index(EndArray, Evaluate("Row(1:" & Rw + 1 & ")"), [transpose(row(1:21))])
End Sub

 

[Waimea]

Hi Fluff,

I apologize and I do apprecite your help and your knowledge!

Your code works but it breaks when I enter something that isn't in the array.

Say I enter Sweden and it works, but if I enter Sweden2 it crashes at this line:

If LCase(MyArray(i, 6)) Like LCase(TextBox3.Text) & "*" Then

With a runtime 9 error: Subscript out or range.

On Error Resume Next works but I guess it isn't a great solution?

 

[Fluff]

I can see no reason why it would break on that line, but you can use this incase of no values found

Private Sub TextBox2_Change()
   Dim MyArray As Variant, EndArray As Variant
   Dim i As Long, j As Long, Rw As Long
   
   If TextBox2.Text = vbNullString Then Exit Sub
   MyArray = Me.ListBox1.List
   
   ReDim EndArray(0 To UBound(MyArray), 0 To 20)
   
   For i = 0 To UBound(MyArray)
      If LCase(MyArray(i, 8)) Like LCase(TextBox2.Text) & "*" Then
         For j = 0 To 20
            EndArray(Rw, j) = MyArray(i, j)
         Next
         Rw = Rw + 1
      End If
   Next
   If Rw > 0 Then
      ListBox1.List = Application.Index(EndArray, Evaluate("Row(1:" & Rw + 1 & ")"), [transpose(row(1:21))])
   Else
      MsgBox "Not found"
   End If
End Sub

 

[Waimea]

Hi Fluff,

now it works really well, big thank you for your help!

I am trying to add the following lines of code to your new code?

If TextBox1.Text = vbNullString Then
   ListBox1.List = MyArray
   Exit Sub
Else
   MyArray = ListBox1.List
End If

So that if I remove everything in TextBox1, it shows the unfiltered array?