Dependant Combo boxes, filter and displayed data from another worksheet

[gsrai31]

Can someone please help me with 3 dependant combo boxes, which automatically populate with unique values from column A, B and C.

I have attached a simple spreadsheet as an example of what I am trying to achieve here.
I have a huge worksheet called “data”. On another worksheet called “filter”, I would like 3 combo boxes. I want combobox 1 to populate from column A from data worksheet with unique values. Then depending on what is selected in combobox1, I would like combobox2 to populate values from column B and then depending selection based on combobox 1 and 2, I want combobox3 to populate values from column C. All selections need to be optional; user may just want filter data by using any of 3 combo boxes.

Once user has made all 3 or 1 or 2 selections, I want records from data worksheet (from certain columns only) to be filter and display on Filter worksheet. I hope it makes sense when looking at attached example workbook.

Thanks in advance for your help.

[mahaveersomani]

give me some time i will try


Regards
CA Mahaveer Somani

[jraj1106]

Hi.

I have created filter data macro. Check if all the conditions are satisfied.

Comboboxes.xlsm

[jindon]

Try the attached

[gsrai31]

Hi jindon - thank you very much for this. I cant open your file properly. I get an error, saying the file is locked for editing, can you please upload it again for me. One thing I would also like to add is that if I remove and add coloum headers on Filter worksheet, then data for only those headers is filtered where column headers match with column headers in data sheet. So if a user decides to change the order of columns on Filter worksheet or adds or removes a column headers then data for only those columns is displayed in Filter worksheet. Also when workbook is opened can all three combo boxes be prepopulated with all unique values. Thank you again.

Hi Jraj1106 - thanks for what uploaded, very good. I will make use use of your solution too, but I need to produce this in excel 2003. Thanks again.

[mlitz80]

Hi jindon - thank you very much for this. I cant open your file properly. I get an error, saying the file is locked for editing, can you please upload it again for me. One thing I would also like to add is that if I remove and add coloum headers on Filter worksheet, then data for only those headers is filtered where column headers match with column headers in data sheet. So if a user decides to change the order of columns on Filter worksheet or adds or removes a column headers then data for only those columns is displayed in Filter worksheet. Also when workbook is opened can all three combo boxes be prepopulated with all unique values. Thank you again.

Hi Jraj1106 - thanks for what uploaded, very good. I will make use use of your solution too, but I need to produce this in excel 2003. Thanks again.

Hi there,

your help is required and would be appreciated. I intend to do the same thing with more data but need to show the three combo boxes in userform not in excel worksheet.

did the same with combox boxes in userform and followed your code but did not work. need your help.

Thanks

[jindon]

That's odd.

I can download and open it with no error and working as expected.

I saved the file as 97-2003 compatible as your uploaded file and it is not locked.

Anyway here's a code
To Filter sheet module

Option Explicit

Private dic As Object

Private Sub Worksheet_Activate()
    Dim a, i As Long, ii As Long, w(), temp
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    a = Sheets("data").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic.exists(a(i, 1)) Then
            ReDim w(1 To 2)
            Set w(1) = _
            CreateObject("Scripting.Dictionary")
            w(1).CompareMode = 1
            ReDim temp(1 To 8, 1 To 1)
            For ii = 1 To 8
                temp(ii, 1) = a(i, ii + IIf(ii > 3, 1, 0))
            Next
            w(2) = temp
            dic(a(i, 1)) = w
        Else
            w = dic(a(i, 1))
            temp = w(2)
            ReDim Preserve temp(1 To 8, 1 To UBound(temp, 2) + 1)
            For ii = 1 To 8
                temp(ii, UBound(temp, 2)) = a(i, ii + IIf(ii > 3, 1, 0))
            Next
            w(2) = temp
            dic(a(i, 1)) = w
        End If
        If Not dic(a(i, 1))(1).exists(a(i, 2)) Then
            ReDim w(1 To 2)
            Set w(1) = _
            CreateObject("Scripting.Dictionary")
            w(1).CompareMode = 1
            ReDim temp(1 To 8, 1 To 1)
            For ii = 1 To 8
                temp(ii, 1) = a(i, ii + IIf(ii > 3, 1, 0))
            Next
            w(2) = temp
            dic(a(i, 1))(1)(a(i, 2)) = w
        Else
            w = dic(a(i, 1))(1)(a(i, 2))
            temp = w(2)
            ReDim Preserve temp(1 To 8, 1 To UBound(temp, 2) + 1)
            For ii = 1 To 8
                temp(ii, UBound(temp, 2)) = a(i, ii + IIf(ii > 3, 1, 0))
            Next
            w(2) = temp
            dic(a(i, 1))(1)(a(i, 2)) = w
        End If
        If Not dic(a(i, 1))(1)(a(i, 2))(1).exists(a(i, 3)) Then
            ReDim temp(1 To 8, 1 To 1)
        Else
            temp = dic(a(i, 1))(1)(a(i, 2))(1)(a(i, 3))
            ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) + 1)
        End If
        For ii = 1 To UBound(temp, 1)
            temp(ii, UBound(temp, 2)) = a(i, ii + IIf(ii > 3, 1, 0))
        Next
        dic(a(i, 1))(1)(a(i, 2))(1)(a(i, 3)) = temp
    Next
    Me.ComboBox1.List = dic.keys
End Sub

Private Sub ComboBox1_Change()
    Dim w
    With Me
        .ComboBox2.Clear
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox1.ListIndex <> -1 Then
            .ComboBox2.List = dic(.ComboBox1.Value)(1).keys
            w = dic(.ComboBox1.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = Application.Transpose(w)
        End If
    End With
End Sub

Private Sub ComboBox2_Change()
    Dim w
    With Me
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox2.ListIndex <> -1 Then
            .ComboBox3.List = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1).keys
            w = dic(.ComboBox1.Value)(1)(.ComboBox2.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
            Application.Transpose(w)
        End If
    End With
End Sub

Private Sub ComboBox3_Change()
    Dim w
    With [b8:h8]
        .CurrentRegion.Offset(1).ClearContents
        If Me.ComboBox3.ListIndex <> -1 Then
            w = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1)(Me.ComboBox3.Value)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
                        Application.Transpose(w)
        End If
    End With
End Sub

To Thisworkbook module

Private Sub Workbook_Open()
    Run Sheets("filter").CodeName & ".worksheet_activate"
End Sub

[gsrai31]

Thank you very much. this is great. Is it possible to filter data for based on column headers row, so if I add or remove colums or change order of colums in Fliter worksheet, values from only those columns are displayed?

[jraj1106]

Did you view the code? I use 2007.

[jindon]

Replace the codes in "Filter" sheet module with

Option Explicit

Private dic As Object

Private Sub Worksheet_Activate()
    Dim a, i As Long, ii As Long, w(), temp
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Application.EnableEvents = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        a = [b8].CurrentRegion.Value
        For i = 1 To UBound(a, 2)
            .Item(a(1, i)) = i
        Next
        a = Sheets("data").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If Not dic.exists(a(i, 1)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1)) = w
            Else
                w = dic(a(i, 1))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1)) = w
            End If
            If Not dic(a(i, 1))(1).exists(a(i, 2)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1))(1)(a(i, 2)) = w
            Else
                w = dic(a(i, 1))(1)(a(i, 2))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1))(1)(a(i, 2)) = w
            End If
            If Not dic(a(i, 1))(1)(a(i, 2))(1).exists(a(i, 3)) Then
                ReDim temp(1 To .Count, 1 To 1)
            Else
                temp = dic(a(i, 1))(1)(a(i, 2))(1)(a(i, 3))
                ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
            Next
            dic(a(i, 1))(1)(a(i, 2))(1)(a(i, 3)) = temp
        Next
    End With
    Me.ComboBox1.List = dic.keys
    Application.EnableEvents = True
End Sub

Private Sub ComboBox1_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox2.Clear
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox1.ListIndex <> -1 Then
            .ComboBox2.List = dic(.ComboBox1.Value)(1).keys
            w = dic(.ComboBox1.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox2_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox2.ListIndex <> -1 Then
            .ComboBox3.List = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1).keys
            w = dic(.ComboBox1.Value)(1)(.ComboBox2.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
            Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox3_Change()
    Dim w
    Application.EnableEvents = False
    With [b8:h8]
        .CurrentRegion.Offset(1).ClearContents
        If Me.ComboBox3.ListIndex <> -1 Then
            w = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1)(Me.ComboBox3.Value)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
                        Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [b8].CurrentRegion.Rows(1)) Is Nothing Then
        Run Me.CodeName & ".Worksheet_Activate"
    End If
End Sub

[gsrai31]

Hi jraj1106, yes I tested the file you uploaded. It's good, but when you play around with combo boxes, it overwrites on some rows rather than first clearing old data etc. Also when you move from one worksheet to another, selected data disappears, as a user it will be slightly anoying. It needs more work to make it more neater, Jindon's solution takes care of some of the issues, but I need to filter data based on whatever column headers I have in fllter worksheet. Similar to select query. thanks

[jraj1106]

I worked on it based on your specifications. Sorry that I couldn't be of any help.

Thanks for your feedback..

[gsrai31]

Hi Jindon - perfect !! Just to make sure it will work in my final workbook, lets say if I had upto 50 columns in data worksheet, the solution will still work or will i need to amend the code? Also at some stage, it's not important, but will be useful, when the workbook is first opened, is it possible all 3 comboboxes pre-populated with unique values. And when first selection is made only then dependant criteria kicks in.
jraj1106 - thank you, you were great help.

[jraj1106]

I worked on it based on your specifications. Sorry that I couldn't be of any help.

Thanks for your feedback..

[jindon]

Replace "Filter" module code with

Option Explicit

Private dic As Object

Private Sub Worksheet_Activate()
    Dim a, i As Long, ii As Long, w(), temp
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Application.EnableEvents = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        a = [b8].CurrentRegion.Value
        For i = 1 To UBound(a, 2)
            .Item(a(1, i)) = i
        Next
        a = Sheets("data").Cells(1).CurrentRegion.Value
        For ii = 1 To 3
            For i = 2 To UBound(a, 1)
                If a(i, ii) <> "" Then dic(a(i, ii)) = Empty
            Next
            Me.OLEObjects("ComboBox" & ii).Object.List = dic.keys
            dic.RemoveAll
        Next
        For i = 2 To UBound(a, 1)
            If Not dic.exists(a(i, 1)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1)) = w
            Else
                w = dic(a(i, 1))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1)) = w
            End If
            If Not dic(a(i, 1))(1).exists(a(i, 2)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1))(1)(a(i, 2)) = w
            Else
                w = dic(a(i, 1))(1)(a(i, 2))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1))(1)(a(i, 2)) = w
            End If
            If Not dic(a(i, 1))(1)(a(i, 2))(1).exists(a(i, 3)) Then
                ReDim temp(1 To .Count, 1 To 1)
            Else
                temp = dic(a(i, 1))(1)(a(i, 2))(1)(a(i, 3))
                ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
            Next
            dic(a(i, 1))(1)(a(i, 2))(1)(a(i, 3)) = temp
        Next
    End With
    Me.ComboBox1.List = dic.keys
    Application.EnableEvents = True
End Sub

Private Sub ComboBox1_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox2.Clear
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox1.ListIndex <> -1 Then
            .ComboBox2.List = dic(.ComboBox1.Value)(1).keys
            w = dic(.ComboBox1.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = Application.Transpose(w)
        Else
            Run Me.CodeName & ".worksheet_activate"
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox2_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox2.ListIndex <> -1 Then
            .ComboBox3.List = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1).keys
            w = dic(.ComboBox1.Value)(1)(.ComboBox2.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
            Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox3_Change()
    Dim w
    Application.EnableEvents = False
    With [b8:h8]
        .CurrentRegion.Offset(1).ClearContents
        If Me.ComboBox3.ListIndex <> -1 Then
            w = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1)(Me.ComboBox3.Value)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
                        Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [b8].CurrentRegion.Rows(1)) Is Nothing Then
        Run Me.CodeName & ".Worksheet_Activate"
    End If
End Sub

[gsrai31]

Hi Jindon, when I use the latest code you sent, I get runtime error 91. Object variable or with block variable not set. On debug it points me to this line of the code: .ComboBox2.List = dic(.ComboBox1.Value)(1).keys
I also need to know if I wanted combox3 populated from another column in the data worksheet, rather then column C, where exactly what in the code, I need to change. Thanks for all your help.

[jindon]

try this

Option Explicit

Private dic As Object

Private Sub Worksheet_Activate()
    Dim a, i As Long, ii As Long, w(), temp, myCols
    Const Colref As Long = 3  '<-- Col reference for combo3
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Application.EnableEvents = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        a = [b8].CurrentRegion.Value
        For i = 1 To UBound(a, 2)
            .Item(a(1, i)) = i
        Next
        a = Sheets("data").Cells(1).CurrentRegion.Value
        myCols = VBA.Array(1, 2, Colref)
        For ii = 0 To UBound(myCols)
            For i = 2 To UBound(a, 1)
                If a(i, myCols(ii)) <> "" Then dic(a(i, myCols(ii))) = Empty
            Next
            Me.OLEObjects("ComboBox" & ii + 1).Object.List = dic.keys
            dic.RemoveAll
        Next
        For i = 2 To UBound(a, 1)
            If Not dic.exists(a(i, 1)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1)) = w
            Else
                w = dic(a(i, 1))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1)) = w
            End If
            If Not dic(a(i, 1))(1).exists(a(i, 2)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1))(1)(a(i, 2)) = w
            Else
                w = dic(a(i, 1))(1)(a(i, 2))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 1))(1)(a(i, 2)) = w
            End If
            If Not dic(a(i, 1))(1)(a(i, 2))(1).exists(a(i, Colref)) Then
                ReDim temp(1 To .Count, 1 To 1)
            Else
                temp = dic(a(i, 1))(1)(a(i, 2))(1)(a(i, Colref))
                ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
            Next
            dic(a(i, 1))(1)(a(i, 2))(1)(a(i, Colref)) = temp
        Next
    End With
    Me.ComboBox1.List = dic.keys
    Application.EnableEvents = True
End Sub

Private Sub ComboBox1_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox2.Clear
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox1.ListIndex <> -1 Then
            .ComboBox2.List = dic(.ComboBox1.Value)(1).keys
            w = dic(.ComboBox1.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = Application.Transpose(w)
        Else
            Run Me.CodeName & ".worksheet_activate"
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox2_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox3.Clear
        [b8].CurrentRegion.Offset(1).ClearContents
        If .ComboBox2.ListIndex <> -1 Then
            .ComboBox3.List = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1).keys
            w = dic(.ComboBox1.Value)(1)(.ComboBox2.Value)(2)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
            Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox3_Change()
    Dim w
    Application.EnableEvents = False
    With [b8:h8]
        .CurrentRegion.Offset(1).ClearContents
        If Me.ComboBox3.ListIndex <> -1 Then
            w = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1)(Me.ComboBox3.Value)
            [b9].Resize(UBound(w, 2), UBound(w, 1)).Value = _
                        Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [b8].CurrentRegion.Rows(1)) Is Nothing Then
        Run Me.CodeName & ".Worksheet_Activate"
    End If
End Sub

[stewfeed]

Hi jindon! I would like to understand the code you've created for gsrai31. I need to do a very similar task but I am completely ignorant of what's in that code so I can't edit it to suit my data. I have posted here but can't get enough help. I'm sorry but I really need to understand these codes as soon as possible. Thank you....

[gsrai31]

I still get run time error. One of your earlier code works fine. My only question now is if I want one of the comboboxes to populate from another column in data then where an what I change in the code. thank you very much for your help.

[jindon]

No idea why you are getting the error.

[gsrai31]

Excellent, this is just great. Thank you so much for your help.

[gsrai31]

Hi Jindon, Can you please help me with this again. Similar to the Filter tab, you kindly developed for me, I need another worksheet where I can apply different filters and display certain records from same data worksheet. I have attached the same example workbook with some dummy data and new tab called Filter2. This the one I would like to be able apply filters and display data. If you can comment your code so I can point comboboxes to differnt columns to populate these to make them fit to my main workbook. thanks again.

[jindon]

1) To filter2 sheet module;

Option Explicit

Private dic As Object

Private Sub Worksheet_Activate()
    Dim a, i As Long, ii As Long, w(), temp, myCols
    Const Colref As Long = 11  '<-- Col reference for combo3
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Application.EnableEvents = False
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        a = [b6].CurrentRegion.Value
        For i = 1 To UBound(a, 2)
            .Item(a(1, i)) = i
        Next
        a = Sheets("data").Cells(1).CurrentRegion.Value
        myCols = VBA.Array(10, 4, Colref)
        For ii = 0 To UBound(myCols)
            For i = 2 To UBound(a, 1)
                If a(i, myCols(ii)) <> "" Then dic(a(i, myCols(ii))) = Empty
            Next
            Me.OLEObjects("ComboBox" & ii + 1).Object.List = dic.keys
            dic.RemoveAll
        Next
        For i = 2 To UBound(a, 1)
            If Not dic.exists(a(i, 10)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 10)) = w
            Else
                w = dic(a(i, 10))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 10)) = w
            End If
            If Not dic(a(i, 10))(1).exists(a(i, 4)) Then
                ReDim w(1 To 2)
                Set w(1) = _
                CreateObject("Scripting.Dictionary")
                w(1).CompareMode = 1
                ReDim temp(1 To .Count, 1 To 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), 1) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 10))(1)(a(i, 4)) = w
            Else
                w = dic(a(i, 10))(1)(a(i, 4))
                temp = w(2)
                ReDim Preserve temp(1 To .Count, 1 To UBound(temp, 2) + 1)
                For ii = 1 To UBound(a, 2)
                    If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
                Next
                w(2) = temp
                dic(a(i, 10))(1)(a(i, 4)) = w
            End If
            If Not dic(a(i, 10))(1)(a(i, 4))(1).exists(a(i, Colref)) Then
                ReDim temp(1 To .Count, 1 To 1)
            Else
                temp = dic(a(i, 10))(1)(a(i, 4))(1)(a(i, Colref))
                ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                If .exists(a(1, ii)) Then temp(.Item(a(1, ii)), UBound(temp, 2)) = a(i, ii)
            Next
            dic(a(i, 10))(1)(a(i, 4))(1)(a(i, Colref)) = temp
        Next
    End With
    Me.ComboBox1.List = dic.keys
    Application.EnableEvents = True
End Sub

Private Sub ComboBox1_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox2.Clear
        .ComboBox3.Clear
        [b6].CurrentRegion.Offset(1).ClearContents
        If .ComboBox1.ListIndex <> -1 Then
            .ComboBox2.List = dic(.ComboBox1.Value)(1).keys
            w = dic(.ComboBox1.Value)(2)
            [b7].Resize(UBound(w, 2), UBound(w, 1)).Value = Application.Transpose(w)
        Else
            Run Me.CodeName & ".worksheet_activate"
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox2_Change()
    Dim w
    Application.EnableEvents = False
    With Me
        .ComboBox3.Clear
        [b6].CurrentRegion.Offset(1).ClearContents
        If .ComboBox2.ListIndex <> -1 Then
            .ComboBox3.List = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1).keys
            w = dic(.ComboBox1.Value)(1)(.ComboBox2.Value)(2)
            [b7].Resize(UBound(w, 2), UBound(w, 1)).Value = _
            Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub ComboBox3_Change()
    Dim w
    Application.EnableEvents = False
    With [b6]
        .CurrentRegion.Offset(1).ClearContents
        If Me.ComboBox3.ListIndex <> -1 Then
            w = dic(Me.ComboBox1.Value)(1)(Me.ComboBox2.Value)(1)(Me.ComboBox3.Value)
            [b7].Resize(UBound(w, 2), UBound(w, 1)).Value = _
                        Application.Transpose(w)
        End If
    End With
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [b6].CurrentRegion.Rows(1)) Is Nothing Then
        Run Me.CodeName & ".Worksheet_Activate"
    End If
End Sub

2) Replace ThisWorkbook module code with;

Private Sub Workbook_Open()
    Run Sheets("filter").CodeName & ".worksheet_activate"
    Run Sheets("filter2").CodeName & ".worksheet_activate"
End Sub

[gsrai31]

Great, thank you very much jindon.
I really appreciate your help with this.

[jindon]

How deep you know about array and Dictionary object?

You have working sample codes and workbook in this thread, where do you not understand?

I don't want to explain from the basics of the array and Dictionary object anyway.

[stewfeed]

Well, about array and Dictionary, I pretty much understand nothing about it. But I would be very grateful if you could tell me what the lines of the code you just posted here do and how to tweak it.

[jindon]

Tweak for what purpose?

I think you will get better response, if you open your own thread for your problem.

[stewfeed]

I did actually. Please click here. Thank you so much for your time!

[gsrai31]

Hi Jindon, I have couple of further questions on my workbook.
Is it possible to change first combo box to list box, so a user can select more than on items?
Is it possible change source of the list on fly, so if it currently populates from Country column, but If the user wants it to be populated from another column in the data sheet, by selecting source column from some sort of option button or toggle button?
Thank you very much.

[jindon]

You should open a new thread for the last requirement.

Explain clearly for what you really want to do, so that someone will give you the solution.

[gsrai31]

Hi jindon, I have opened a new thread as you suggested. I have a specific question on the code you provided above. If I want to point all 3 combo boxes to different columns for the input ranges, where and what exactly I need change in the code. I can see the comment '<-- Col reference for combo3, but what about other combo boxes. I am not a programmer so finding it difficult to work it out. thanks

[jindon]

I hope someone else can understand what you are trying to and solve it for you.

There maybe logical conflicts in your explanation.

Multiselect listbox1 select 3 items, what will be the list of 2nd listbox?
when multiple item selected from llistbox2, list in listbox3? and the result?

etc.

Anyway it will be so complicated, so I don't want to do it....

[gsrai31]

Hi again, my question here wasn't about listboxes etc. It's about the code you wrote in response to my original thread above for combo1 combo2 and combo3. What do i need change in the code to point combo2 or combo1 to different colomus to change their input range. Thank you.

[gsrai31]

Hi Jindon, I am trying re-use the code you kindly wrote above in your response on 17-01-2013, 10:50 PM above.
I am using this in a similar workbook in Excel 2013, trying to achieve same thing. But in the data I now have a date column formatted as dd/mm/yyyy. But whenever the data is filtered and displayed in "Filter" sheet, the date changes to American mm/dd/yyyy format. Even in the column it is displayed is pre-formatted to dd/mm/yyyy. Is there anything could be done to ensure the date remains as it's? Thanks

[protonLeah]

deleted....

[jindon]

gsrai31

This is your own thread, so you are not violating any of the rule here.

Better post a workbook, so that I can tell you what may be the problem... I hope...

[gsrai31]

Hi Jindon, thank you very much for your initial response. I have uploaded a smaller version of the file with dummy info. When the file is opened it comes up with error 9. Also it takes long time to open in the first place particularly when I have real data with lots of records. I would like combo box lists to be in alphabetical order. Currently it's all over the place. And of course the date format needs to remain in dd/mm/yyyy. Can you please take a look and see if you can help me with sorting this out. Thanks again

[jindon]

What do you expect from the line below?

Run Sheets("filter2").CodeName & ".worksheet_activate"

You have no sheet name "filter2" and no code to execute....

[gsrai31]

Hi Jindon Thanks for pointing this out, there was a filter2 sheet with similar functionality as fitler1 in the original workbook. Removing the line fixes error 9. I should have noticed that.
Could you please help with the rest of the issues? thank you.

[jindon]

See if the attached works.

[gsrai31]

Hi Jindon, I am afraid it hasn't fixed the date issue.
Some dates are displayed correctly in dd/mm/yyyy, and some appear in mm/dd/yyyy format.
Also the combo box items list is not in alphabetical order.
Thanks

[jindon]

Busy at the moment, so I will look at it later.

[jindon]

gsrai31

Reg date format, it is only the cell formatting issue as far as the values are serial date in the formula bar.

Other than the above, you are asking too much for the free forum.

[gsrai31]

Hi Jindon, the cell formatting is correct values are incorrect in the cells and in the formula bar. The data only contains dates for Jan 16 where as the dates displayed for Aug, Oct, Dec months. Where the date is 8th Jan, it's changes to 1st Aug when displayed in Filter sheet. Thanks.

[jindon]

It is showing

2016/1/1
2016/1/8
2016/1/8
2016/1/8
2016/1/9
2016/1/9
2016/1/9
2016/1/10
2016/1/10
2016/1/12
2016/1/12
2016/1/12
2016/1/12

in the formula bar here for each row, so serial date.

[gsrai31]

Thanks Jindon, it very strange, it is not working for me. I tried changing the date column to all types of different formats in the Filter sheet and in the source data. Even tried changing it to text format. But as you will see in the attached image, some dates appear correctly but few records and some particularly first few records at the top and a few at the bottom of the filtered list, always show as incorrect dates, regardless of the cell formatting.