Interdependent Comboboxes and filtering

Samir Ranjan Bhowmik 1 Reputation point
2021-10-05T11:20:28.6+00:00

Hello,

I have a userform with multiple comboboxes where the data are based on unique values from a table "DynamicPath_2" from a sheet called "MDB". I managed to get a working code from another forum member in another site but when I apply the code to my file it makes my excel stop functionning and give an error message as "excel has stopped working". I am quite new to VBA, and I am not able to find the bug which is creating this slowdown or crash.

Could anyone help me resolve the problem by checking the code and if required even scrap the whole thing with a better piece of code?

Here is the code that I have for the moment that I could gather and adapt through other forums

Option Explicit
'adjust sheet name & table name
Private Const sList As String = "MDB"
Private Const sTable As String = "DynamicPath_2"

Dim d As Object
Dim va, ary, arT
Dim XN As Long

Sub toFilter(FN As Long)
Dim c As Range, f As Range, x, vb
Dim i As Long, j As Long, p As Long, w As Long

i = Application.Match(FN, ary, 0) - 1
With Me.Controls("ComboBox" & FN)
If IsNumeric(i) Then
If .Value = "" Then
For Each x In ary
Me.Controls("ComboBox" & x).Clear
Next

        d.RemoveAll

            For Each x In Application.Index(va, , arT(i))
                d(x) = Empty
            Next

        .List = d.keys
    Else
        Set f = Sheets(sList).ListObjects(sTable).DataBodyRange.Columns((arT(i)))

            Set c = f.Find(.Value, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

            If Not c Is Nothing Then
                p = arT(i)
                For w = 0 To UBound(arT)
                    If w <> i Then
                        d.RemoveAll
                        For j = 1 To UBound(va, 1)
                        vb = Application.Index(va, , arT(w))
                            If va(j, p) = .Value Then
                                d(vb(j, 1)) = Empty
                            End If
                        Next
                        Controls("ComboBox" & ary(w)).List = d.keys
                    End If
                Next

            Else
                For Each x In ary
                     If x <> FN Then Me.Controls("ComboBox" & x).Clear
                Next


            End If
    End If
End If

End With

End Sub

Private Sub ComboBox1_Change()
If XN = 1 Then Call toFilter(XN)
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.Value = ""
XN = 1: Call toFilter(XN)
End Sub

Private Sub ComboBox2_Change()
If XN = 2 Then Call toFilter(XN)

Dim myRange As Range, f As Range

Set myRange = Worksheets("MDB").Range("B:C")

Set f = myRange.Find(What:=ComboBox2.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False) '<--| try and find combobox selected value
If f Is Nothing Then
TextBox1.Value = ""
Else '<--| ... otherwise...
TextBox1.Value = f.Offset(, -1)

End If

End Sub

Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox2.Value = ""
XN = 2: Call toFilter(XN)
End Sub

Private Sub ComboBox3_Change()
If XN = 3 Then Call toFilter(XN)
End Sub

Private Sub ComboBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox3.Value = ""
XN = 3: Call toFilter(XN)
End Sub

Private Sub UserForm_Initialize()
'ary & arT must be in correct order
'combobox name, the number part, combobox1,combobox2,combobox7
ary = Array(1, 2, 3)
'column number in table, DynamicPath_2
arT = Array(1, 3, 4)

va = Sheets(sList).ListObjects(sTable).DataBodyRange.Value

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

End Sub

Note: The table is quite large with more than 30000 rows of data

Thank you in advance

Office Development
Office Development
Office: A suite of Microsoft productivity software that supports common business tasks, including word processing, email, presentations, and data management and analysis.Development: The process of researching, productizing, and refining new or existing technologies.
3,488 questions
0 comments No comments
{count} votes