Autonumerar Código en formulario teniendo en cuenta registros eliminados
Es una pregunta para Dante Amor
Hola
Tenemos un formulario "Añadir", que sirve para añadir registros y ahora mismo cuando pulso el botón AÑADIR el Codigo se autonumera incrementalmente y se sitúa el cursor, se sitúa el foco en Titulo... Hasta aquí todo bien.
El problema me surge solo cuando elimino un registro...
Parto de la base que el código de cada registro es único y exclusivo de ese registro esté o no eliminada la fila, ese código ya no se debe utilizar por otro registro y el tema es que si yo elimino por ejemplo el último registro de código R003565 y quiero Añadir un registro nuevo se me autogenera otra vez para el nuevo registro el código R003565 y no debería, debería generarse el R003566 porque aunque haya borrado el registro R003565 ese código ya no lo debo usar más porque pertenece a un registro exclusivo esté o no eliminado de la hoja.
Si por ejemplo eliminara el R003555 y el R003565 pues debería al abrir el formulario "Añadir" generarse en Codigo, el R003566, porque los otros 2 códigos ya no se pueden usar, es decir estén o no eliminados los registros debe tenerlos en cuenta a la hora de autonumerar.
1 Respuesta
H o l a:
Te anexo la macro para autonumerar el código
'
Private Sub UserForm_Activate()
'Por.Dante Amor
Set h1 = Sheets("TITULOS")
Set h3 = Sheets("CATALOGOS")
Set h4 = Sheets("BORRADOS")
u = h1.Range("A" & Rows.Count).End(xlUp).Row
u4 = h4.Range("A" & Rows.Count).End(xlUp).Row
ucol = h1.Cells(1, Columns.Count).End(xlToLeft).Column
letra = Evaluate("=SUBSTITUTE(ADDRESS(1," & ucol & ",4),""1"","""")")
'Ordenar versión 2003
h1.Range("A1:" & letra & u).Sort Key1:=h1.Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
h4.Range("A1:B" & u4).Sort Key1:=h4.Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Ordenar versión 2007
'With h1.Sort
' .SortFields.Clear: .SortFields.Add Key:=h1.Range("A2:A" & u)
' .SetRange h1.Range("A1:" & letra & u): .Header = xlYes: .Apply
'End With
reg1 = Val(Mid(h1.Cells(u, "A"), 2))
reg4 = Val(Mid(h4.Cells(u4, "A"), 2))
reg = Application.Max(reg1, reg4) + 1
Label1 = "R" & Format(reg, "000000")
'
For i = 2 To h3.Range("A" & Rows.Count).End(xlUp).Row
ComboBox1.AddItem h3.Cells(i, "A")
Next
For i = 2 To h3.Range("B" & Rows.Count).End(xlUp).Row
ComboBox2.AddItem h3.Cells(i, "B")
Next
For i = 2 To h3.Range("C" & Rows.Count).End(xlUp).Row
ComboBox3.AddItem h3.Cells(i, "C")
Next
End SubS a l u d o s
