Macro para cargar combobox sin duplicados

Tengo la siguiente macro para cargar un combobox sin duplicados, pero no me salen todos los registro.

Private Sub UserForm_Initialize()
Dim fila As Integer, final As Integer, registro As Integer
fila = 1
Do While Hoja8.Cells(fila, 2) <> ""
fila = fila + 1
Loop
final = fila - 1

With Hoja8
For fila = 2 To final
registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(fila, 1)), .Cells(fila, 1))
If registro = 1 Then
cbo_not.AddItem .Cells(fila, 1)
End If
Next fila
End With

2 Respuestas

Respuesta
1
Respuesta
1

Lo que debe estar pasando es que buscas el fin de rango en col 2 (Do While Hoja8. Cells(fila, 2) <> "")

Pero luego llenas el combobox desde la col 1 y quizás haya más datos que el fin de rango que encontraste en col 2 si tu col B se parece a la imagen:

Te dejo la macro ajustada. Si no se encuentran otros datos debajo de tu tabla puedes utilizar la única instrucción que busca la variable 'final' en lugar de recorrer toda la tabla.

Private Sub UserForm_Initialize()
Dim fila As Integer, final As Integer, registro As Integer
final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row
With Hoja8
For fila = 2 To final
    registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(fila, 1)), .Cells(fila, 1))
    If registro = 1 Then
        cbo_not.AddItem .Cells(fila, 1)
    End If
Next fila
End With
End Sub

¡Gracias! 

A la primera Gracias¡¡¡¡¡¡¡¡¡¡

Buenas

Tal y como te comente ya no aparecen registros repetidos, pero ahora al cargar los datos del combobox no se rellenan el resto de casillas.

Pongo todo el código.

Private Sub UserForm_Initialize()
Dim Fila As Integer, Final As Integer, registro As Integer
Final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row
With Hoja8
For Fila = 2 To Final
registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(Fila, 1)), .Cells(Fila, 1))
If registro = 1 Then
cbo_not.AddItem .Cells(Fila, 1)
End If
Next Fila
End With

ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = "50pt; 150 pt;60 pt;60 pt;250 pt;60 pt;60 pt"
End Sub


Private Sub cbo_not_Change()


Dim Fila As Integer
Dim Final As Integer

If cbo_not.Value = "" Then
Me.cbo_pt = ""
Me.txt_fecha = ""
Me.txt_descrip = ""
Me.eje1 = ""
Me.eje2 = ""
Me.eje3 = ""
Me.txt_equipo = ""
End If

For Fila = 2 To 1000
If Hoja8.Cells(Fila, 1) = "" Then
Final = Fila - 1
Exit For
End If
Next
For Fila = 2 To Final
If cbo_not = Hoja8.Cells(Fila, 1) Then
Me.cbo_pt = Hoja8.Cells(Fila, 3)
Me.txt_equipo = Hoja8.Cells(Fila, 4)
Me.txt_fecha = Hoja8.Cells(Fila, 2)
Me.txt_descrip = Hoja8.Cells(Fila, 5)
Me.eje1 = Hoja8.Cells(Fila, 6)
Me.eje2 = Hoja8.Cells(Fila, 7)
Me.eje3 = Hoja8.Cells(Fila, 8)

Exit For
End If
Next
End Sub

Private Sub CommandButton1_Click()
Dim Fila, Final As Integer
Fila = 2
For Fila = 2 To Final
If Me.cbo_not = Hoja8.Cells(Fila, 1) Then
Exit For
End If
Next
If Me.cbo_not.Value = Empty Then
Me.ListBox1.Clear
' Me.txt_equipo = Empty
' Me.txt_marcaymodelo = Empty
' Me.txt_saldo = Empty
'MsgBox "Escriba un codigo para buscar"
'Me.txt_buscar.SetFocus
' Exit Sub
End If
Me.ListBox1.Clear


items = Hoja8.Range("tabla5").CurrentRegion.Rows.Count
For i = 2 To items
If Hoja8.Cells(i, 1).Value Like Me.cbo_not.Value _
And Hoja8.Cells(i, 2).Value Like Me.txt_fecha Then
Me.ListBox1.AddItem Hoja8.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja8.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Hoja8.Cells(i, 11)
' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Hoja8.Cells(i, 11)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Hoja8.Cells(i, 11)
' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Hoja3.Cells(i, 12)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Hoja3.Cells(i, 13)
End If
Next i
Exit Sub


End Sub

Creo que casi todo lo que comento a continuación en el código ya lo comenté... o me estoy confundiendo de usuario lo que también es probable ;)

Copia el código tal como te lo dejo. Porque estás utilizando una variable 'Final' que siempre empieza de 0 al declararla dentro de la subrutina cuando debiera estar fuera para uso general.

Dim Final As Integer
Private Sub UserForm_Initialize()
Dim Fila As Integer, registro As Integer
'encontrar última celda con datos en col A..... fin de rango
Final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row
With Hoja8
For Fila = 2 To Final
registro = WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(Fila, 1)), .Cells(Fila, 1))
If registro = 1 Then
cbo_not.AddItem .Cells(Fila, 1)
End If
Next Fila
End With
ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = "50pt; 150 pt;60 pt;60 pt;250 pt;60 pt;60 pt"
End Sub
Private Sub cbo_not_Change()
Dim Fila As Integer
    'Dim Final As Integer 'la variable se utiliza de modo público ... se declara al inicio del módulo
If cbo_not.Value = "" Then       
    Me.cbo_pt = ""
    Me.txt_fecha = ""
    Me.txt_descrip = ""
    Me.eje1 = ""
    Me.eje2 = ""
    Me.eje3 = ""
    Me.txt_equipo = ""
    EXIT SUB                 'si el combo está vacío debe cancelar el evento Change 
End If
'encontrar última fila con datos.... con 1 sola instrución ! ! 
Final = Hoja8.Range("A" & Rows.Count).End(xlUp).Row
    'For Fila = 2 To 1000
    'If Hoja8.Cells(Fila, 1) = "" Then
    'Final = Fila - 1
    'Exit For
    'End If
    'Next
For Fila = 2 To Final
    If cbo_not = Hoja8.Cells(Fila, 1) Then
        Me.cbo_pt = Hoja8.Cells(Fila, 3)        'evita los ME ! ! 
        Me.txt_equipo = Hoja8.Cells(Fila, 4)
        Me.txt_fecha = Hoja8.Cells(Fila, 2)
        Me.txt_descrip = Hoja8.Cells(Fila, 5)
        Me.eje1 = Hoja8.Cells(Fila, 6)
        Me.eje2 = Hoja8.Cells(Fila, 7)
        Me.eje3 = Hoja8.Cells(Fila, 8)    
        Exit For
    End If
Next
End Sub
Private Sub CommandButton1_Click()
Dim Fila as Integer  
    'Dim Final As Integer 'la variable se utiliza de modo público ... se declara al inicio del módulo
Fila = 2
For Fila = 2 To Final
If Me.cbo_not = Hoja8.Cells(Fila, 1) Then
Exit For
End If
Next
If Me.cbo_not.Value = Empty Then       'evita los Me ! ! 
Me.ListBox1.Clear
' Me.txt_equipo = Empty
' Me.txt_marcaymodelo = Empty
' Me.txt_saldo = Empty
'MsgBox "Escriba un codigo para buscar"
'Me.txt_buscar.SetFocus
' Exit Sub
End If
Me.ListBox1.Clear
items = Hoja8.Range("tabla5").CurrentRegion.Rows.Count
For i = 2 To items
If Hoja8.Cells(i, 1).Value Like Me.cbo_not.Value _
And Hoja8.Cells(i, 2).Value Like Me.txt_fecha Then
Me.ListBox1.AddItem Hoja8.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja8.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Hoja8.Cells(i, 11)
' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Hoja8.Cells(i, 11)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Hoja8.Cells(i, 11)
' Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Hoja3.Cells(i, 12)
'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Hoja3.Cells(i, 13)
End If
Next i
    'Exit Sub      'No hace falta Exit sub si luego viene el End Sub
End Sub

Cuando hagas un poco de limpieza en el código lo verás mucho más claro. 

Si luego queda aún algo por ajustar me lo envías nuevamente.

Sdos!

¡Gracias! 

Aunque esto que me compartiste me vino bien para depurar el código no funciono. Creo que es debido a como introduzco los datos . que es a través de otro formulario.

Este punto del código creo que es el me da problemas , por que en otro formulario  de búsqueda no me da ese problema. (Hoja8.Cells(Final, 2) = Me.txt_fecha.Text)

Hoja8.Cells(Final, 1) = Comprb

Espero esta vez haberme explicado bien.

Private Sub btn_Procesar_Click()

Dim Fila As Integer
Dim Final As Integer
Dim Existencia As Integer
Dim altas As Integer
Dim Comprb As Long


Hoja4.Range("h1").Value = Hoja4.Range("h1").Value + 1
Comprb = Hoja4.Range("h1").Value
If Me.cbo_not.Text = Empty Or _
Me.txt_fecha.Text = Empty Or _
Me.eje1.Text = Empty Or _
Me.eje2.Text = Empty Or _
Me.ListBox1.ListCount = 0 Or _
Me.ListBox2.ListCount = 0 Then
MsgBox "Hay cambios vacios en el PARTE"""
Exit Sub
End If

Fila = 2
Do While Hoja8.Cells(Fila, 1) <> ""
Fila = Fila + 1
Loop

Final = Fila
For i = 0 To Me.ListBox1.ListCount - 1
Hoja8.Cells(Final, 9) = Me.ListBox1.List(i, 0)
Hoja8.Cells(Final, 10) = Me.ListBox1.List(i, 1)
Hoja8.Cells(Final, 11) = Me.ListBox1.List(i, 2)
Hoja8.Cells(Final, 1) = Comprb
Hoja8.Cells(Final, 2) = Me.txt_fecha.Text
Hoja8.Cells(Final, 3) = Me.cbo_not
Hoja8.Cells(Final, 4) = Me.txt_equipo
Hoja8.Cells(Final, 5) = Me.txt_descrip
Hoja8.Cells(Final, 6) = Me.eje1
Hoja8.Cells(Final, 7) = Me.eje2
Hoja8.Cells(Final, 8) = Me.eje3
Final = Final + 1
Next i

Entonces coloca en un libro los 2 uf y la hoja de trabajo con solo un par de datos y envíamelo al correo cibersoft. Arg de Gmail.

(Aparecen en portada de mi sitio)

Sdos!

Lo que mencionas que falla no tiene que nada que ver con el tema de la consulta original (llenar un combobox sin duplicados).

La parte del código que no está correcto aunque no da error la instrucción, es la del guardado de la fecha. Y esto para todos los UF donde tengas que guardar fechas en celdas.

Los controles Textbox guardan texto (en la imagen fechas alineadas a izquierda como texto).

Utiliza CDATE para convertirlas a fechas válidas.

 Hoja8.Cells(Final, 2) = CDate(Me.txt_fecha.Text)

PD) Con esto damos por cerrado esta consulta ... que nos estamos saliendo del tema.

Sdos!

La pregunta no admite más respuestas

Más respuestas relacionadas