change code of combobox to not duplicate values

Hi people.

Can anyone help me please? I want that the Combox1 don't show the duplicated values. Thanks

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub


    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count


    ComboBox1.Clear

    Set r = Range(Cells(2, 1), Cells(rws, 1))

    For Each c In r.Cells

        y = Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(c.Row, 1)), c)

        If y = 1 Then ComboBox1.AddItem c

    Next c

    With ComboBox1

        .Activate
        .Application.SendKeys ("%{down}")
        
    End With


End Sub

See if this works? I added some code that I use for Access.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim notFound As Boolean
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub


    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count


    ComboBox1.Clear

    Set r = Range(Cells(2, 1), Cells(rws, 1))

    For Each c In r.Cells

        y = Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(c.Row, 1)), c)

        If y = 1 Then
            notFound = True
            For k = 0 To ComboBox1.ListCount - 1
                If c = ComboBox1.ItemData(k) Then
                    notFound = False
                    Exit For
                End If
            Next
            If notFound Then
                ComboBox1.AddItem c
            End If
        End If
    Next c

    With ComboBox1

        .Activate
        .Application.SendKeys ("%{down}")
        
    End With


End Sub

Perhaps this:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub


    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count


    ComboBox1.Clear

    Set R = Range(Cells(2, 1), Cells(rws, 1))

    For Each c In R.Cells
        y = Application.WorksheetFunction.CountIf(R, c)
        If y = 1 Then ComboBox1.AddItem c
    Next c

    With ComboBox1

        .Activate
        .Application.SendKeys ("%{down}")
        
    End With

End Sub

Try

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub

    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count

    ComboBox1.List = Filter(Evaluate("transpose(if(countif(offset(a2:a" & rws & ",0,0,row(1:" & _
        rws - 1 & ")),a2:a" & rws & ")=1,a2:a" & rws & ",char(2)))"), Chr(2), 0)
End Sub

Trabalhadores.xlsm

Hi. It didnt work. Can u people see the file? i Think its more easier to understand.

Thanks

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub

    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count
    
    ComboBox1.ListFillRange = ""

    ComboBox1.List = Filter(Evaluate("transpose(if(countif(offset(a2:a" & rws & ",0,0,row(1:" & _
        rws - 1 & ")),a2:a" & rws & ")=1,a2:a" & rws & ",char(2)))"), Chr(2), 0)
End Sub

Originally Posted by jindon

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub

    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count
    
    ComboBox1.ListFillRange = ""

    ComboBox1.List = Filter(Evaluate("transpose(if(countif(offset(a2:a" & rws & ",0,0,row(1:" & _
        rws - 1 & ")),a2:a" & rws & ")=1,a2:a" & rws & ",char(2)))"), Chr(2), 0)
End Sub

Sorry. i tried this code but the combox1 continue with duplicated names. can u send me the file with that modification? Thanks

See attached.

Hi. isn't working. when i define the range on combobox1 properties, the names apears duplicated.
see jpegTrabalhadores.JPG

Don't touch Combobox property in attached file, just click on C1.

Thank you. its working

One more thing please. i would like to move the two comboboxs to Sheet2 but mantaining the lists in sheet1. What i have to change in code?

'----------------------------------------------------------
Dim rng As Range, c As Range, r As Range, f As Range
Dim rws As Long, y As Integer



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub

    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count
    
    ComboBox1.ListFillRange = ""

    ComboBox1.List = Filter(Evaluate("transpose(if(countif(offset(a2:a" & rws & ",0,0,row(1:" & _
        rws - 1 & ")),a2:a" & rws & ")=1,a2:a" & rws & ",char(2)))"), Chr(2), 0)
End Sub


Private Sub ComboBox1_Change()


    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count

    ComboBox2.Clear

    Set r = Range(Cells(1, 1), Cells(rws, 1))

    For Each c In r.Cells


        If c = ComboBox1 Then ComboBox2.AddItem c.Offset(0, 1)

    Next c

    With ComboBox2

        .Activate
        .Application.SendKeys ("%{down}")

    End With


End Sub

Thanks

Hi. the combobox1 is already working in sheet2, but combobox2 don't work. Can anyone help me? Thanks

'----------------------------------------------------------
Dim rng As Range, c As Range, r As Range, f As Range
Dim rws As Long, y As Integer



Private Sub ComboBox2_Change()

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$C$1" Then Exit Sub

    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count
    
    Sheets("Sheet2").ComboBox1.ListFillRange = ""

     Sheets("Sheet2").ComboBox1.List = Filter(Evaluate("transpose(if(countif(offset(a2:a" & rws & ",0,0,row(1:" & _
        rws - 1 & ")),a2:a" & rws & ")=1,a2:a" & rws & ",char(2)))"), Chr(2), 0)
End Sub



Private Sub ComboBox1_Change()


    rws = ActiveSheet.UsedRange.Columns(1).Rows.Count

    Sheets("Sheet2").ComboBox2.Clear

    Set r = Range(Cells(1, 1), Cells(rws, 1))

    For Each c In r.Cells


        If c = Sheets("Sheet2").ComboBox1 Then Sheets("Sheet2").ComboBox2.AddItem c.Offset(0, 1)

    Next c

    With Sheets("Sheet2").ComboBox2

        .Activate
        .Application.SendKeys ("%{down}")

    End With


End Sub

Sheet2???? where is it?

sorry. i didnt upload the file updated.

Trabalhadores.xlsm

...................

Thank you.

one more question. please. i would like to have a button in sheet2 to run the Reset combobox1 that is on sheet1

How can i do it?

Thanks

What for?

Why on Sheet2?

That doesn't make sense to me.

Originally Posted by jindon

What for?

Why on Sheet2?

That doesn't make sense to me.

Because i want to hide the sheet1. i don't want people change that data.

But i need people have possibility of clean combobox and make a new search.

I already thought another way, that click in button, the system selects the c1 of sheet1. It works but system shows the moves. i already put screenupdating false, but he shows the moves =/ and stays on sheet1. i want he stays in sheet2

i have this

Private Sub CommandButton1_Click()
Application.Goto (ActiveWorkbook.Sheets("Sheet1").Range("c1"))
End Sub

i already tried to change but gives error =/

Hi. Problem solved.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
ActiveSheet.Cells(1, 3).Select
Sheets("Sheet2").Activate
End Sub