Creating DropDown by ComboBox1 and Filter the Desired Column

[Shazir]

I want to filter the column via ComboBox1 where ComboBox1 will load the unique values and upon selecting one of them will filter the column data accordingly.

I have tried at my end to make this code work but could not.

Any help will be highly appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
 
 Dim lastrow As Long
 
 With Sheets("Sheet1").Range("I15:I" & lastrow)
    v = .Value
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .exists(e) Then .Add e, Nothing
    Next
    If .Count Then Sheets("Sheet1").ComboBox1.List = Application.Transpose(.keys)
End With
 
 lastrow = Cells(Rows.Count, "I").End(xlUp).Row
 
 With Me
 If Not Intersect(Target, .Range("I1")) Is Nothing Then
 If Target.Value <> "" Then
 .AutoFilterMode = False
.Range("I15:I" & lastrow).AutoFilter field:=1, Criteria1:=Target.Value
 End If
 End If
 End With

 

[Akuini]

1. My suggestion: because you pick the criteria via combobox then it's better to use "ComboBox1_Change" event instead of "Worksheet_Change" to trigger the filter.
2. Could you upload a sample workbook to a free site such as dropbox.com or google drive & then put the link here?
It will make it easier to test and find a solution.

 

[Shazir]

Yes something is irrelevant that i have been made.

Sure here is the workbook Sir.

Book1.xlsm

drive.google.com

 

[Akuini]

OK, try this:
The list will be narrowed down as you type
You can use multiple keywords separated by a space.
Use down/up arrow to navigate then hit Enter to select item.

ComboBox1 and Filter the Desired Column - Shazir.xlsm

Shared with Dropbox

www.dropbox.com

Option Explicit
'=============== YOU MAY NEED TO ADJUST THE CODE IN THIS PART: ===================================

'sheet's name where the list (for combobox) is located
Private Const sList As String = "Sheet1"

'cell of the header
Private Const sCell As String = "I15"

Private vList
Private rngX As Range

Private Sub ComboBox1_GotFocus()
Dim d As Object, x

With Sheets(sList)
    Sheets(sList).AutoFilterMode = False

    Set rngX = .Range(sCell, .Cells(.Rows.Count, .Range(sCell).Column).End(xlUp))
    vList = rngX.Offset(1).Value
        
        Set d = CreateObject("scripting.dictionary")
        For Each x In vList
              d(x) = Empty
        Next
        If d.Exists("") Then d.Remove ""
    vList = Application.Transpose(Array(d.Keys))
End With
   
    
    With ComboBox1
        .MatchEntry = fmMatchEntryNone
        .Value = ""
        .List = vList
        'ComboBox1.ListRows = 10 'to show how many item
    End With

End Sub


Private Sub ComboBox1_Change()

Dim x, d As Object
   
With ComboBox1
If .Value <> "" And IsError(Application.Match(.Value, vList, 0)) Then
    Set d = CreateObject("scripting.dictionary")
    For Each x In vList
        If LCase(x) Like "*" & Replace(LCase(.Value), " ", "*") & "*" Then
          d(x) = Empty
        End If
    Next
       .List = d.Keys
       .DropDown
    ElseIf .Value <> "" Then
         
         Sheets(sList).AutoFilterMode = False
         rngX.AutoFilter field:=1, Criteria1:=ComboBox1.Value
    
    Else
        .List = vList
    End If

End With
End Sub

 

[Shazir]

Sir this error is occur when run the code . Variable not defined

 

[Akuini]

Not sure why that happen, do you have any other code beside mine?
Try this:
Delete "Option Explicit" in the top of the code, then see what happen.

 

[Shazir]

Thank you |Sir, its working thank you.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.

 

[Shazir]

Akuini​

Sir, I appreciate the help you provided.

But I am having an issue that i have added further ComboBox2 for Col"J" how can i do add this i am unable to understand that how the ComboBox1 takes value from "I1" .

Let me show the code that i have added. Please have a look if its possible.

Option Explicit
'=============== YOU MAY NEED TO ADJUST THE CODE IN THIS PART: ===================================

'sheet's name where the list (for combobox) is located
Private Const sList As String = "Sheet1"

'cell of the header
Private Const sCell As String = "I15"
Private Const mCell As String = "J15"

Private vList
Private rngX As Range

Private Sub ComboBox1_GotFocus()
Dim d As Object, x
With Sheets(sList)
    Sheets(sList).AutoFilterMode = False
    Set rngX = .Range(sCell, .Cells(.Rows.Count, .Range(sCell).Column).End(xlUp))
    vList = rngX.Offset(1).Value
        Set d = CreateObject("scripting.dictionary")
        For Each x In vList
              d(x) = Empty
        Next
        If d.Exists("") Then d.Remove ""
    vList = Application.Transpose(Array(d.Keys))
End With
    With ComboBox1
        .MatchEntry = fmMatchEntryNone
        .Value = ""
        .List = vList
        'ComboBox1.ListRows = 10 'to show how many item
    End With
End Sub


Private Sub ComboBox1_Change()
Dim x, d As Object
With ComboBox1
If .Value <> "" And IsError(Application.Match(.Value, vList, 0)) Then
    Set d = CreateObject("scripting.dictionary")
    For Each x In vList
        If LCase(x) Like "*" & Replace(LCase(.Value), " ", "*") & "*" Then
          d(x) = Empty
        End If
    Next
       .List = d.Keys
       .DropDown
    ElseIf .Value <> "" Then
         Sheets(sList).AutoFilterMode = False
         rngX.AutoFilter field:=1, Criteria1:=ComboBox1.Value
    Else
        .List = vList
    End If
End With
End Sub


'===================================
'ComboBox2
'===================================


Private Sub ComboBox2_GotFocus()
Dim d As Object, x
With Sheets(sList)
    Sheets(sList).AutoFilterMode = False
    Set rngX = .Range(mCell, .Cells(.Rows.Count, .Range(mCell).Column).End(xlUp))
    vList = rngX.Offset(1).Value
        Set d = CreateObject("scripting.dictionary")
        For Each x In vList
              d(x) = Empty
        Next
        If d.Exists("") Then d.Remove ""
    vList = Application.Transpose(Array(d.Keys))
End With
    With ComboBox2
        .MatchEntry = fmMatchEntryNone
        .Value = ""
        .List = vList
        'ComboBox2.ListRows = 10 'to show how many item
    End With
End Sub


Private Sub ComboBox2_Change()
Dim x, d As Object
With ComboBox2
If .Value <> "" And IsError(Application.Match(.Value, vList, 0)) Then
    Set d = CreateObject("scripting.dictionary")
    For Each x In vList
        If LCase(x) Like "*" & Replace(LCase(.Value), " ", "*") & "*" Then
          d(x) = Empty
        End If
    Next
       .List = d.Keys
       .DropDown
    ElseIf .Value <> "" Then
         Sheets(sList).AutoFilterMode = False
         rngX.AutoFilter field:=1, Criteria1:=ComboBox2.Value
    Else
        .List = vList
    End If
End With
End Sub

 

[Akuini]

I check your new code, you did it right, so what's the problem?

i am unable to understand that how the ComboBox1 takes value from "I1" .

You mean "I15" right:
First, populate value in cells "I15" to last row to vList

Set rngX = .Range(sCell, .Cells(.Rows.Count, .Range(sCell).Column).End(xlUp))
    vList = rngX.Offset(1).Value

then populate vList to combobox:

   With ComboBox1
        .MatchEntry = fmMatchEntryNone
        .Value = ""
        .List = vList
        'ComboBox1.ListRows = 10 'to show how many item
    End With