hola Dante
adjunto lo solicitado
en el CommandButton3 esta al ingresar y busca si el numero esta repetido y se repite elimina la línea y genera una nueva
Private Sub CommandButton3_Click()
'Hoja4.Activate
On Error Resume Next
Me.TextBox1.Text = Format(CInt(TextBox1.Text), "0000000")
'Me.txtNoFactura.Text = Format(CInt(txtNoFactura.Text), "0000000")
Err.Clear
If Trim(Me.TextBox1.Text) = "" Or Trim(Me.TextBox1.Text) = " " Then MsgBox ("Ingresar Nro Factura!!"): Exit Sub
Err.Clear
On Error Resume Next
Hoja4.Activate
ultm = Range("f65536").End(xlUp).Row
primm = Range("f1").Row
i = primm
Do Until Cells(i, 6) = Me.TextBox1.Text
If i <= ultm Then
i = i + 1
Else
Exit Do
End If
Loop
Cells(i, 6).Activate
If ActiveCell.Value = Trim(Me.TextBox1.Text) Then
If MsgBox("La FT ya existe Desea Eliminar y Volver ha Generar", vbQuestion + vbYesNo) = vbYes Then
buscarftrow
Else
TextBox1.Text = " "
Exit Sub
End If
Else
ActiveCell.Select
End If
Set h1 = Worksheets("INGRESOS")
u = h1.Range("c" & Rows.Count).End(xlUp).Row + 1
For i = 0 To ListBox6.ListCount - 1
h1.Cells(u, "E") = ListBox4.List(i) 'Cantidad
'h1.Cells(u, "C") = ListBox2.List(i) 'Unidad
h1.Cells(u, "c") = ListBox6.List(i) 'Descripción
h1.Cells(u, "F") = TextBox1 'Factura
h1.Cells(u, "G") = ListBox7.List(i) 'Precio
h1.Cells(u, "B") = ListBox3.List(i) 'codigo
h1.Cells(u, "a") = TextBox4.Text 'proveedor
h1.Cells(u, "I") = ComboBox1.Text 'almacen
h1.Cells(u, "h") = DTPicker1 'fecha
u = u + 1
Next
linea
limpiarTodo
Unload Me
Worksheets.Save
Private Sub buscarftrow()
'Sheets("ingresos").Select
Dim primera As Variant
Dim ultima As Variant
On Error Resume Next
Hoja4.Activate
ultima = Range("f65536").End(xlUp).Row
primera = Range("f1").Row
i = ultima
Do Until Cells(i, 6) = TextBox1.Text
If i > 1 Then
i = i - 1
Else
Exit Do
End If
Loop
If i <> 1 Then
Cells(i, 6).Select
ULTIMAENC = Cells(i, 6).Row
Else
End If
ult = Range("f65536").End(xlUp).Row
prim = Range("f1").Row
i = prim
Do Until Cells(i, 6) = TextBox1.Text
If i < ult Then
i = i + 1
Else
Exit Do
End If
Loop
If i <> ult Then
Cells(i, 6).Select
PRIMENC = Cells(i, 6).Row
End If
Range("A" & PRIMENC, "A" & ULTIMAENC).Select
Selection.EntireRow.Delete
End Sub
saludos
Robert