Macro para quitar repetidos de listbox
----------------
Buena tarde
Pueden ayudarme con esto
Necesito que en listbox no me aparezcan repetidos
Utilizo esto para mostrar la lista
Private Sub ComboBox1_Change()
Dim subt As Long
Dim en As Integer
Dim subt2 As Long
If Me.ComboBox1.Value = Empty Then
Me.ListBox1.Clear
Me.ComboBox1.SetFocus
Exit Sub
End If
Me.ListBox1.Clear
items2 = Hoja19.Range("A" & Rows.Count).End(xlUp).Row
'items = Hoja12.Range("a3:a500").CurrentRegion.Rows.Count
For i = 3 To items2
If LCase(Hoja19.Cells(i, 4).Value) Like "*" & LCase(Me.ComboBox1.Value) & "*" Then
Me.ListBox1.AddItem Hoja19.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja19.Cells(i, 3)
End If
Next i
End Sub
1 Respuesta
Te anexo la macro
Private Sub ComboBox1_Change()
'Act.Por.Dante Amor
Me.ListBox1.Clear
If Me.ComboBox1.Value = Empty Then Exit Sub
'
Me.ListBox1.Clear
For i = 3 To Hoja19.Range("A" & Rows.Count).End(xlUp).Row
If LCase(Hoja19.Cells(i, 4).Value) Like "*" & LCase(Me.ComboBox1.Value) & "*" Then
existe = False
For j = 0 To ListBox1.ListCount - 1
If Hoja19.Cells(i, 3) = ListBox1.List(j, 0) Then
existe = True
Exit For
End If
Next
If existe = False Then
Me.ListBox1.AddItem Hoja19.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja19.Cells(i, 2)
End If
End If
Next i
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
