no experience for populate data in listbox based on selected item from another listbox

[Amer Omar]

Hi experts,
I search too much to populate data in listbox based on selected item from another listbox.
all of what I found it just by txtbox . I don't wanted .
I have two simple codes
first show data in listbox2 based on Expenses Detailes sheet as in image1

Private Sub UserForm_Initialize()
   Dim LastRow As Long
   
   
    LastRow = Range("A" & Rows.Count).End(xlUp).Row    '<---- ??????
    With ListBox2
        .ColumnCount = 7
        .ColumnWidths = "70;70;170;130;70;70;70"
        .List = Range("A2:G" & LastRow).Value
    End With
    
End Sub

Form
	A	B	C	D	E	F
1	DATE	Exchange authorization number	Expense Name	Expense Describtion	Account number	Amount
2	01/01/2024	A00	hospitality	Lunch for three persons	safe1	300.00
3	01/01/2024	A01	Stationery	Files & Mony Rubber	Main Safe	250.00
4	01/01/2024	A02	maintenance	Tires & Disco	safe1	1,200.00
5	02/01/2024	A03	maintenance	Electricity Car	safe1	2,500.00
6	02/01/2024	A04	hospitality	Lunch for Four persons	Main Safe	430.00
7	02/01/2024	A05	Stationery	Paper for Printer	Main Safe	100.00
8	03/01/2024	A06	Stationery	Transparent files	safe1	120.00
9	03/01/2024	A07	Salaries of employees and workers	Ten Employees & workers	Muth Bank	20,000.00
10	03/01/2024	A08	Goods packing workers	Three Trucks	safe1	900.00
11	03/01/2024	A09	hospitality	Lunch for Six persons	safe1	750.00
12	04/01/2024	A10	Office Furniture	Three Tables For Offie	Muth Bank	1,500.00
13	04/01/2024	A11	Shop rent	Advanced month	Muth Bank	7,600.00
14	04/01/2024	A12	hospitality	Lunch for Two persons	Main Safe	275.00
15	04/01/2024	A13	maintenance	Mechanic	safe1	1,670.00
Expenses Detailes

second image when select optionbutton1 based on Detailes sheet then will populate data in listbox1

Private Sub OptionButton1_Click()
Dim LastRow As Long
   Dim ws As Worksheet
   Set ws = Sheets("Detailes")
   If OptionButton1.Value = True Then
   
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row    '<---- ??????
    With ListBox1
        .ColumnCount = 1
        .List = ws.Range("A2:A" & LastRow).Value
    End With
    End If
End Sub

Form
	A
1	EXPENSES NAME
2	hospitality
3	maintenance
4	Personal withdrawals
5	Cleaning materials
6	Stationery
7	Shop rent
8	Salaries of employees and workers
9	Renting the transportation of goods
10	Workers unloading goods
11	Goods packing workers
12	Goods shipping costs
13	Office Furniture
14	Laptop & Office Furniture
15	Office Furniture
16	Cars
Detailes

what I expect as in picture.
should match selected item from listbox1 with the column(3) in listbox2 and filter data in listbox2 for the select item from listbox1 like this

I have no Experience for that ,I look forward from the expert to do that with considering data could be 10000 rows in Expenses Detailes.
Thanks.

 

[John_w]

what I expect as in picture.
should match selected item from listbox1 with the column(3) in listbox2 and filter data in listbox2 for the select item from listbox1 like this

Try this (code in the userform module):

Private Sub ListBox1_Click()

    Dim lastRow As Long, numRows As Long
    Dim r As Long, c As Long, n As Long
    Dim filteredData() As Variant
    
    Me.ListBox2.Clear
    
    With Worksheets("Expenses Detailes")
        
        Application.ScreenUpdating = False
        
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=Me.ListBox1.List(Me.ListBox1.ListIndex)
        
        numRows = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If numRows > 0 Then
            ReDim filteredData(1 To numRows, 1 To 7)
            n = 0
            For r = 2 To lastRow
                If Not .Rows(r).EntireRow.Hidden Then
                    n = n + 1
                    For c = 1 To 7
                        filteredData(n, c) = .Cells(r, c).Value
                    Next
                End If
            Next
            Me.ListBox2.List = filteredData
        End If
        
        .Range("A1").CurrentRegion.AutoFilter
        Application.ScreenUpdating = True
                
    End With
        
End Sub

 

[Amer Omar]

Hi,
it's excellent !
can you guide me how show date formating and numbrs like this
DD/MM/YYYY
#,##0.00
please?

 

[John_w]

Two lines to add and I show where to add them:

                    For c = 1 To 7
                        filteredData(n, c) = .Cells(r, c).Value
                    Next
                    filteredData(n, 1) = Format(filteredData(n, 1), "DD/MM/YYYY")
                    filteredData(n, 6) = Format(filteredData(n, 6), "#,##0.00")

 

[Amer Omar]

just occures in lastrow as in the picture!

 

[John_w]

Post the whole ListBox1_Click routine so I can see where you've put the 2 new lines.

 

[dmt32]

@John_w - hope don't mind making a suggestion - have you thought about using the Range.Text property when adding to the array?

filteredData(n, c) = .Cells(r, c).Text

may resolve OPs issue

Dave

 

[John_w]

@dmt32 - a good idea that hadn't occurred to me, thanks.

OP - the change is then simply this, and the 2 new lines aren't needed:

                    For c = 1 To 7
                        filteredData(n, c) = .Cells(r, c).Text
                    Next

That will display values in the ListBox using the same formats as the sheet cells.

 

[Amer Omar]

Post the whole ListBox1_Click routine so I can see where you've put the 2 new lines.

this problem happened when I work at laptop in my work
here is the code

Private Sub ListBox1_Click()

    Dim lastRow As Long, numRows As Long
    Dim r As Long, c As Long, n As Long
    Dim filteredData() As Variant
    
    Me.ListBox2.Clear
    
    With Worksheets("Expenses Detailes")
        
        Application.ScreenUpdating = False
        
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=Me.ListBox1.List(Me.ListBox1.ListIndex)
        
        numRows = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If numRows > 0 Then
            ReDim filteredData(1 To numRows, 1 To 7)
            n = 0
            For r = 2 To lastRow
                If Not .Rows(r).EntireRow.Hidden Then
                    n = n + 1
                    For c = 1 To 7
                        filteredData(n, c) = .Cells(r, c).Value
                    Next
                    filteredData(n, 1) = Format(filteredData(n, 1), "DD/MM/YYYY")
                    filteredData(n, 6) = Format(filteredData(n, 6), "#,##0.00")
                End If
            Next
            Me.ListBox2.List = filteredData
        End If
        
        .Range("A1").CurrentRegion.AutoFilter
        Application.ScreenUpdating = True
                
    End With
        
End Sub

but now I'm at home works perfectly !
i
I no know what's my bad!
but I will check tomorrow and inform you what happens for me .

 

[Amer Omar]

Hi Dave !
based on your suggestion and without using suggestion in post # 4 that works perfectly .
thanks buddy