Porque la numeración automática cuando termino de eliminar el último registro me queda 1 en mi excel
Expertos tengo un formulario en excel la cual me trabaja todo perfecto me guarda, me elimina el registro, el formulario programado tiene un módulo de Numeración la cual lo jalo, lo que hace este módulo cuando por ejemplo si tuviera registros 1,2,3,4,5 y elimino la posición 3 la macros lo automatiza y lo deja 1,2,3,4 ya que elimine un registro hasta allí todo perfecto, mi problema es que cuando elimino el ultimo registro me queda este bendito numero 1 en mi excel lo cual también lo carga en mi lisbox y no se que se debe he tratado de hacer de todo pero no he logrado eliminarlo por completo.
Adjunto imagen de prueba.
y esta otra imagen es cuando termino de eliminar los registro y así queda
[Hola Cristian. Puedes hacer una captura de la macro?
¡Gracias!
Ese es el código fuente el programa corre todo perfecto guarda, elimina, el único inconveniente que tengo es que cuando elimino el ultimo registro queda ese bendito numero 1 en el excel.
'Numeracion automática de las especialidades
Sub OrdenItemEspecialidad()
On Error GoTo error
Dim ContNum As Long
Dim ultimalinea As Long
ultimalinea = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A7").Select
ContNum = 0
Do Until ContNum = 2 Or ActiveCell.Value = ""
If ActiveCell.Value <> "" Then
ContNum = ContNum + 1
ActiveCell.Offset(1, 0).Select
End If
Loop
If ContNum = 2 Then
Range("A7").Value = 1
Range("A8").Value = 2
Range("A7:A8").Select
Selection.AutoFill Destination:=Range("A7:A" & ultimalinea)
Else
Range("A7").Value = 1
End If
Exit Sub
error:
End Sub
Private Sub Guarda_Especialidad()
On Error GoTo error
Dim ContCodigo, ContItem As Long
Sheets("Especialidad").Select
Range("A1").Select
'Buscar la primera celda vacía
Application.GoTo Reference:="R65000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
'Genera Item
If ActiveCell.Offset(-0, 1) = "Item" Then
ContItem = 1
Else
ContItem = ActiveCell.Offset(-0, 1) + 1
End If
'Corregir datos
ActiveCell.Offset(0, 0).Value = ContItem
ActiveCell.Offset(0, 1).Value = TxtEspecialidad
ActiveCell.Offset(0, 2).Value = TxtCantidad
Call OrdenItemEspecialidad
Call LimparCamposEspecialidad
Call CargarListaEspecialidad
MsgBox "Postulante registrado con éxito!", vbInformation, "Cadastro"
Exit Sub
error:
End Sub
Sub CargarListaEspecialidad()
On Error GoTo error
Dim arrayItems()
Dim VResultado As Boolean
Dim linea, columna, Cont, NItem, Nlineas, ContItem, ColocaItem As Long
Dim MyList
Cont = 1
NItem = 0
Nlineas = Sheets("Especialidad").Range("A100").End(xlUp).Row 'Cuenta número de lineas existentes
If Nlineas = 1 Then
Else
ReDim arrayItems(1 To Nlineas, 1 To Sheets("Especialidad").UsedRange.Columns.Count)
With Me.LstEspecialidad
.Clear
.ColumnCount = 3
.ColumnWidths = "30; 360; 50"
With Sheets("Especialidad")
MyList = .Range("A1:A" & Nlineas)
For linea = 7 To UBound(MyList)
'Limpia memoria
VResultado = False
VResultado = .Range("B" & linea).Value Like "*" + "*"
If VResultado Then
Me.LstEspecialidad.AddItem
For columna = 1 To 3
arrayItems(Cont, columna) = .Cells(linea, columna).Value
Next columna
Cont = Cont + 1
End If
Next linea
Me.LstEspecialidad.List = arrayItems()
End With
End With
End If
Exit Sub
error:
End Sub
Private Sub EliminarEspecialidad()
On Error GoTo error
If lineaSelecionadaEspecialidad = 0 Then
MsgBox "Selecione una Especialidad!", vbExclamation, "Eliminar"
Exit Sub
ElseIf MsgBox("Desea realmente continuar?", vbQuestion + vbYesNo, "Eliminar") = vbYes Then
Sheets("Especialidad").Select
'Procedimento que localiza a linea
EncontrarEspecialidad = lineaSelecionadaEspecialidad
If Trim(EncontrarEspecialidad) <> "" Then
With Sheets("Especialidad").Range("A:A")
Set EncontrarCelula = .Find(what:=EncontrarEspecialidad, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not EncontrarCelula Is Nothing Then
Application.GoTo EncontrarCelula, True
'Eliminar linea
ActiveCell.Offset(0, 0).Rows.EntireRow.Delete
LstEspecialidad.Clear
Call OrdenItemEspecialidad
Call LimparCamposEspecialidad
Call CargarListaEspecialidad
MsgBox "Especialidad excluído con éxito!", vbInformation, "Eliminar"
End If
End With
End If
End If
Exit Sub
error:
End Sub
Private Sub BtnCancelar_Click()
On Error GoTo error
Call LimparCamposEspecialidad
Call CargarListaEspecialidad
Exit Sub
error:
End Sub
Private Sub BtnEliminar_Click()
Call EliminarEspecialidad
End Sub
Private Sub BtnGuardar_Click()
On Error GoTo error
Call Guarda_Especialidad
Exit Sub
error:
End Sub
Private Sub LstEspecialidad_Click()
On Error GoTo error
If LstEspecialidad.Column(0) <> "" Then
lineaSelecionadaEspecialidad = LstEspecialidad.Column(0)
TxtEspecialidad.Enabled = True
TxtCantidad.Enabled = True
TxtEspecialidad = LstEspecialidad.Column(1)
TxtCantidad = LstEspecialidad.Column(2)
BtnGuardar.Enabled = False
BtnEliminar.Enabled = True
BtnCancelar.Enabled = True
Else
Call LimparCamposEspecialidad
TxtEspecialidad.Enabled = False
TxtCantidad.Enabled = False
BtnGuardar.Enabled = False
BtnEliminar.Enabled = False
BtnCancelar.Enabled = False
End If
Exit Sub
error:
End Sub
Private Sub UserForm_Initialize()
On Error GoTo error
Call CargarListaEspecialidad
Exit Sub
error:
End Sub
1 respuesta más de otro experto
H0la Cristian:
El 1 sale de acá Range("A7").Value = 1 lo marqué en negrita dentro del código.
Sub OrdenItemEspecialidad()
On Error GoTo error
Dim ContNum As Long
Dim ultimalinea As Long
ultimalinea = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A7").Select
ContNum = 0
Do Until ContNum = 2 Or ActiveCell.Value = ""
If ActiveCell.Value <> "" Then
ContNum = ContNum + 1
ActiveCell.Offset(1, 0).Select
End If
Loop
If ContNum = 2 Then
Range("A7").Value = 1
Range("A8").Value = 2
Range("A7:A8").Select
Selection.AutoFill Destination:=Range("A7:A" & ultimalinea)
Else
Range("A7").Value = 1
End If
Exit Sub
error:
End Sub
S@lu2
¡Gracias!
Eso sí experto Isaac Reyes el detalle es porque no se elimina por completo cuando le doy al botón eliminar osea elimina los registros bien pero cuando queda un registro y lo elimino siempre queda ese 1 lo cual también me lo carga en mi listbox, la pregunta es se puede eliminar ese 1 definitivamente porque si elimino un registro por completo se supone que no debe quedar nada o no se puede con esa macros realmente.
Saludos
O la solución sería que al else rango("A7").values=""
Lo dejé en vacío no sé si sea o correcto oe equivoco aunque todavía no lo he probado no sé si estoy bien mal.
Saludos
En realidad, si es correcto o no, eso depende de lo que quisiste hacer con esa línea. En lo particular, simplemente yo eliminaría esa línea y el Else que la precede, pero como te digo, depende de lo que tú hayas querido lograr.
S@lu2
¡Gracias! Mi objetivo era la numeración automatizada en el ingreso de un registro cualquiera de tal manera que cuando haga una modificación, eliminacion reinicie la numeración como le puse en el ejemplo si tengo registros 1,2,3 y elimino el registro 2 la macro lo que hace es dejar 1,2 más no 1,3 y mi inconveniente final era que me quedaba ese 1 al final .
Como te digo, si eliminas el Else y esa línea, no debieras tener problemas.
Pruébalo y me comentas.
S@lu2
¡Gracias!
Excelente Isaac Reyes, ya probé ahora si funciona todo correctamente muchas gracias.
Saludos.