SamirRanjanBhowmik-4401 avatar image
0 Votes"
SamirRanjanBhowmik-4401 asked

Interdependent Comboboxes and filtering


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

             For Each x In Application.Index(va, , arT(i))
                 d(x) = Empty
         .List = d.keys
         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
                         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
                         Controls("ComboBox" & ary(w)).List = d.keys
                     End If
                 For Each x In ary
                      If x <> FN Then Me.Controls("ComboBox" & x).Clear

             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

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

0 Answers