How to edit "ComboBox" at Userform option

[2avrham]

Hi,

I want to set one of my columns to "ComboBox" drop down selection at Userform option and I wonder how can i do it.

What I would to get in the end is drop box selection with "WIP", "Hold","Ready" choices selection and after I chose one of them the data is filtered according to it.

My column data:

vpo_status

WIP

WIP

Hold

WIP

Done

WIP

WIP

WIP

Ready

Ready

WIP

WIP

WIP

WIP

WIP

WIP

WIP Thanks!!

<tbody>
</tbody><colgroup><col></colgroup>

 

[ranman256]

I load all the values into an indexed collection. With on error resume next,it ignores the dupes.
then load the collection to the combo,

dim col as new ccollection
dim sWord as string

on error resume next,
 
while Activecell.value<>""
      sWord=Activecell.value
      Col.add sWord,sWord

      Activecell.offset(1,0).select.    'Next row
wend

For I =1 to col.count
   Combo.add col(I)
next

 

[Fluff]

Another option assuming your values are in col A

Option Explicit
Private Dic As Object
Private Ws As Worksheet

Private Sub ComboBox1_Change()
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   Ws.Range("A1").AutoFilter 1, Me.ComboBox1.Value
End Sub

Private Sub UserForm_Initialize()
   Dim Cl As Range

   Set Ws = Sheets("[COLOR=#ff0000]Pcode[/COLOR]")
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = vbTextCompare
   For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, Nothing
   Next Cl
   Me.ComboBox1.List = Dic.keys
End Sub

Change sheet name in red to suit

 

[2avrham]

Hi and thanks for the help, why we have two End sub? it don't need to be under same code?

 

[2avrham]

Hi,
Im not getting any data, probably I miss here something.

 

[2avrham]

Hi,
I succeed to edit it and run it... I do see all my filtered items but I cannot click on them. As soon as I click on one of them It crush probably because I change the code to:

Private Sub Product_Filter_Change()
 
Option Explicit
Private Dic As Object
Private Ws As Worksheet
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   Ws.Range("E6").AutoFilter 1, Me.Product_Filter.Value
End Sub
Private Sub UserForm_Initialize()
   Dim Cl As Range
   Set Ws = Sheets("Sheet1")
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = vbTextCompare
   For Each Cl In Ws.Range("E6", Ws.Range("E" & Rows.Count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, Nothing
   Next Cl
   Me.Product_Filter.List = Dic.keys
End Sub

I had no choice to changed "Private Sub Product_Filter_Change()" location to the beginning of the code because every time I paste it as you wrote It combine "

Option Explicit
Private Dic As Object
Private Ws As Worksheet

rows with upper code of different bottom.

What im doing wrong? Thanks,

 

[Fluff]

You need to put this line

Private Sub Product_Filter_Change()

back to where it was originally. As you have it. the code should not even run.

Also what do you mean by

rows with upper code of different bottom.

 

[2avrham]

Hi,

If I start with

Option Explicit
Private Dic As Object
Private Ws As Worksheet

Lines are automatically move to upper code that I have at VBA ( I use more bottoms in the userform).
It remove the line that separated between the subs.

 

[Fluff]

Your code should be like

Option Explicit
Private Dic As Object
Private ws As Worksheet

Private Sub Product_Filter_Change()
   If ws.AutoFilterMode Then ws.AutoFilterMode = False
   ws.Range("E6").AutoFilter 1, Me.Product_Filter.Value
End Sub

Private Sub UserForm_Initialize()
   Dim Cl As Range

   Set ws = Sheets("Sheet1")
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = vbTextCompare
   For Each Cl In ws.Range("E6", ws.Range("E" & Rows.Count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, Nothing
   Next Cl
   Me.Product_Filter.List = Dic.keys
End Sub

 

[2avrham]

Hi,

see what I means:

Private Sub Com2_Click()
 Rows("5:5").Select
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveSheet.Range("$A$5:$T$771").AutoFilter Field:=11, Criteria1:=Array( _
        "completed"), Operator:=xlFilterValues
End Sub
Option Explicit
Private Dic As Object
Private ws As Worksheet
-------------------------------------------------------------------------------------------------------------------------
Private Sub Product_Filter_Change()
   If ws.AutoFilterMode Then ws.AutoFilterMode = False
   ws.Range("E6").AutoFilter 1, Me.product_filter.Value
End Sub
Private Sub UserForm_Initialize()
   Dim Cl As Range
   Set ws = Sheets("Sheet1")
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = vbTextCompare
   For Each Cl In ws.Range("E6", ws.Range("E" & Rows.Count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, Nothing
   Next Cl
   Me.product_filter.List = Dic.keys
End Sub

It joined the first 3 rows with upper SUB and it failed to run.
In addition I retrieve error on "If ws.AutoFilterMode Then" line any idea why?
Thanks,