Macro para código unicos inventario

Sabes que tengo una hoja (Base Datos) en Excel con 7 columnas (todas con tablas insertadas), donde la A es el nombre del producto y la G es un columna llamada código (todas las columnas están llenas menos código), ahora, yo ingreso los datos desde otra hoja, y quisiera una macro para generar un codigo único para cada producto de la columna A, ( de 0000 a 9999)

¿Me podrías ayudar en esto? Estoy desesperado con esto que no logro hacer.

1 Respuesta

Respuesta
1

Vamos por partes la macro que te pase para hacer lo que pides efectivamente no funciona por la siguiente razón: no estas especificando exactamente que quieres tus explicaciones son muy vagas solo dices quiero que corra desde la hoja detalle diario sin ser especifico si capturabas los datos a través de la hoja o a través de un formulario como parece ser el caso, la respuesta que te doy requiere de tres macros una a nivel modulo que te va a generar los códigos sobre lo que tengas en la hoja base datos, esta tienes que pegarla en un modulo estándar y correrla antes de ejecutar las macros a nivel formulario que vienen más abajo.

Sub AGREGAR_CODIGOS()
Dim CODIGOS As New Collection
Set FUNCION = WorksheetFunction
Set H1 = Worksheets("BASE DATOS")
Set REGISTROS = H1.Range("A2").CurrentRegion
MATRIZ = REGISTROS
For I = 2 To UBound(MATRIZ)
    PRODUCTO = MATRIZ(I, 1)
    With REGISTROS
        CUENTA = FUNCION.CountIf(.Columns(1), PRODUCTO)
        For J = 1 To CUENTA
            If J = 1 Then Set BUSCA = .Find(PRODUCTO)
            If J > 1 Then Set BUSCA = .FindNext(BUSCA)
OTRO:
            CODIGO = FUNCION.RandBetween(1000, 9999)
            On Error Resume Next
            CODIGOS.Add CODIGO, CStr(CODIGO)
            If Err.Number = 0 Then .Cells(I, .Columns.Count + 1) = CODIGO
            If Err.Number > 0 Then GoTo OTRO:
            On Error GoTo 0
        Next J
    End With
Next I
With REGISTROS
    .Cells(1, REGISTROS.Columns.Count + 1) = "CODIGO"
    .Columns(.Columns.Count).Copy
    .Columns(.Columns.Count + 1).PasteSpecial xlPasteFormats
    .Columns(.Columns.Count + 1).NumberFormat = "0000"
End With
End Sub

segundo a nivel formulario le hice unas adecuaciones a tu formulario, le cambie el textbox del producto por un combobox ya que es mas practico para lo que requieres te sugiero hagas lo mismo, la programacion es mas dificil con un textbox como puedes ver añadi un textbox llamadoo textbox7 que es donde te mostrara el registro unico del producto

y ahora estan son las macros que ocupas pegar e el modulo del formulario 

Private Sub ComboBox2_AfterUpdate()
Set REGISTROS = Range("TEMPORAL")
INDICE = ComboBox2.ListIndex + 1
If INDICE > 0 Then
    TextBox7 = REGISTROS.Cells(INDICE, REGISTROS.Columns.Count)
Else
    GENERA_CODIGO
End If
Set registro = Nothing
End Sub
'-----------
Private Sub UserForm_Initialize()
Dim UNICOS As New Collection
Set REGISTROS = Worksheets("BASE DATOS").Range("A2").CurrentRegion
With REGISTROS
    FILAS = .Rows.Count
    Set REGISTROS = .Rows(2).Resize(FILAS)
    For I = 1 To FILAS
        PRODUCTO = .Cells(I, 1)
        On Error Resume Next
            UNICOS.Add PRODUCTO, CStr(PRODUCTO)
            If Err.Number = 0 Then ComboBox2.AddItem PRODUCTO
        On Error GoTo 0
    Next I
End With
REGISTROS.Name = "TEMPORAL"
Set REGISTROS = Nothing:   Set UNICOS = Nothing
End Sub
´----------
Sub GENERA_CODIGO()
Dim UNICOS As New Collection
Set FUNCION = WorksheetFunction
Set REGISTROS = Range("TEMPORAL")
With REGISTROS
OTRO:
    CODIGO = FUNCION.RandBetween(1000, 9999)
    CUENTA = FUNCION.CountIf(.Columns(.Columns.Count), CODIGO)
    If I = 0 Then TextBox7 = CODIGO
    If I > 0 Then GoTo OTRO
    TextBox7.Locked = True
End With
Set REGISTROS = Nothing
End Sub

y estos cambios necesitas hacer en el boton guardar textbox3 tienes que cambiarlo por combobox2.value y añadir estas lineas, respecto a tener tablas dentro de las tablas es muy ineficiente y ocasiona muchos problemas con una sola tabla tienes y que la macro haga las divisiones segun se ocupe la informacion.

Sheets("BASE DATOS").Range("j100000").End(xlUp).Offset(1, 0) = TextBox7.Value
Sheets("BASE DATOS").Range("a100000").End(xlUp).Offset(1, 0) = ComboBox2.Value

Una corrección sobre la ultima parte de la macro cambia la primera línea por esta Sheets("BASE DATOS"). Range("j100000").End(xlUp) = TextBox7.Text o te generara un error.

Hola James

Veo que siempre me respondes, y quiero agradecerte por eso porque el tiempo que le dedicas vale, y te quería pedir si no es mucho abuso que revises la macro directamente porque me da error, cuando uso la maceo ingresar datos y no se que es y ando super estresado con esto.

https://www.dropbox.com/s/bo16uqrq98a1wwv/Proyecto%20INVENTARIO%20CASTILLO%203%20%28Autoguardado%29.xlsm?dl=0 

No sabes cuanto te lo agradecería

Hola James

La macro que genera los códigos están bien para la primer vez, pero en la segunda vez que la corra (con un nuevo producto) me agrega una nueva columna con nuevos códigos, y quiero que se mantengan los mismos códigos anteriores solo que se le genere un nuevo código al nuevo producto.

me podrías ayudar en eso?

gracias

La macro que esta en el modulo estándar solo la corres una vez y te olvidas de ella, para productos nuevos el código se genera desde el formulario, es decir ya no tienes necesidad de correr el código que esta en el modulo, te pase tanto los códigos para el modulo estándar como para el formulario, solo revisa el post copia los códigos y pégalos en el formulario haciendo las adecuaciones que te indique así cada que captures y registres ya tendrá el código único integrado a tu registro.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas