Interdependent Comboboxes and filtering
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