Excel VBA Userform filter listbox content by dependent comboboxes (x3)

Question

Hello to everybody

I found the following discussion very interesting and it is what I am looking for:

https://techcommunity.microsoft.com/t5/excel/excel-vba-userform-filter-listbox-content-by-dependent/m-p/3250102/thread-id/137352

However when I try to adapt to my scenario it doesn't work and I don't know where am I wrong (lack of vba!)

Combo 2 and 3 are not populated at all!

It is the same code except the sheet name and the column address for the combo:

• Column F, E, D original code
• Column B (combo1); I (combo2); Q (combo3) with an 18 listbox columns now.

Here the code:

Option Explicit

Private Sub ComboBox1_Change()

Dim sh As Worksheet 

Dim r As Long 

Dim m As Long 

FillList 

Me.ComboBox2.Clear 

Set sh = Worksheets("New") 

m = sh.Cells.Find(What:="\*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

For r = 2 To m 

    If sh.Range("B" & r) = Me.ComboBox1.Value Then 

        If Application.WorksheetFunction.CountIf(sh.Range("I2:I" & r), sh.Range("I" & r)) = 1 Then 

            Me.ComboBox2.AddItem sh.Range("I" & r).Value 

        End If 

    End If 

Next r   

End Sub

Private Sub ComboBox2_Change()

Dim sh As Worksheet 

Dim r As Long 

Dim m As Long 

FillList 

Me.ComboBox3.Clear 

Set sh = Worksheets("New") 

m = sh.Cells.Find(What:="\*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

For r = 2 To m 

    If sh.Range("I" & r) = Me.ComboBox2.Value Then 

        If Application.WorksheetFunction.CountIf(sh.Range("Q2:Q" & r), sh.Range("Q" & r)) = 1 Then 

            Me.ComboBox3.AddItem sh.Range("Q" & r).Value 

        End If 

    End If 

Next r 

End Sub

Private Sub ComboBox3_Change()

FillList 

End Sub

Private Sub UserForm_Initialize()

Dim sh As Worksheet 

Dim r As Long 

Dim m As Long 

Set sh = Sheets("New") 

m = sh.Cells.Find(What:="\*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

For r = 2 To m 

    If Application.WorksheetFunction.CountIf(sh.Range("B2:B" & r), sh.Range("B" & r)) = 1 Then 

        Me.ComboBox1.AddItem sh.Range("B" & r).Value 

    End If 

Next r 

FillList     

End Sub

Private Sub FillList()

Dim sh As Worksheet 

Dim r As Long 

Dim c As Long 

Dim m As Long 

Dim arr() 

Dim n As Long 

Dim f As Boolean 

Set sh = Worksheets("New") 

m = sh.Cells.Find(What:="\*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

For r = 2 To m 

    f = (sh.Range("B" & r).Value = Me.ComboBox1.Value) Or (Me.ComboBox1.ListIndex = -1) 

    If f Then 

        f = (sh.Range("I" & r).Value = Me.ComboBox2.Value) Or (Me.ComboBox2.ListIndex = -1) 

        If f Then 

            f = (sh.Range("Q" & r).Value = Me.ComboBox3.Value) Or (Me.ComboBox3.ListIndex = -1) 

        End If 

    End If 

    If f Then 

        n = n + 1 

        ReDim Preserve arr(1 To 18, 1 To n) 

        ' Store the row number in the first (hidden) column 

        arr(1, n) = r 

        For c = 2 To 17 

            arr(c + 1, n) = sh.Cells(r, c).Value 

        Next c 

    End If 

Next r 

If n > 0 Then 

    Me.ListBox1.Column = arr 

Else 

    Me.ListBox1.Clear 

End If 

End Sub

Can anyone please help? Thank a lot in advance.

JohnBi

Answer 1

Hi John,

I don't really see a problem with that now.

First we can set "Option Compare Text", then LIKE ignores the spelling.
Then we convert the names in the ComboBox to proper-case and sort them alphabetically.

Calculating the sum is very easy, you have to format the output yourself.
In Excel you can use the NumberFormat to color the font of a cell red if the value is negative, but this is not possible in VBA.

Same example file.

Any further questions?

Andrew.

Answer 2

We need to see your file.

Why a sample file is important for troubleshooting. How to do it. - Microsoft Community

Andreas.

Answer 3

Here is the link: New.xlsm

Thank you very much.
Regards
John

Answer 4

Sample file:

https://www.dropbox.com/scl/fi/syj1253qel3ujccih3517/585b734d-4371-4cb9-bf93-5920d3d258bb.xlsm?rlkey=bbknralbd8nm9hy47y25ccywx&dl=1

Any questions?

BTW, replace your formula in A2: =IFERROR(A1+1,1)

Andreas.

Answer 5

Thank you Andreas, for a prompt reply and a great job!
Seems to be a long, long way for me to match even a part your knowledge!.
Thank you also for the suggested formula (IFERROR).
With your solution, I realize a lot of non-compliance in the "Description" names (some entries in capital letters others mixed, ect) in an approx 6000 rows!

If possible I would like to ask you:

• to add in a textbox the sum of filtered column M (Sum)
• if is ok to modify this part of the code to hide some columns or is there a better way:

     For Each TableCol In Table.ListColumns 
  
       '' .ColumnWidths = .ColumnWidths & ";" & TableCol.DataBodyRange.Width \* 0.75 
  
       .ColumnWidths = "35;100;55;00;0;0;0;0;65;0;0;0;50;0;0;50;55;0" 
  

  Next

Again a great help! Thank you.
Regards John