Macro para encontrar un código existente
hola
tengo un pequeño problemita estoy haciendo un libro de excel en el que deseo manejar un inventario al cual deseo aplicarle algunas macros para que el trabajo sea mas sencillo y el problema que me presenta es que al inicio tengo una hoja en donde ingreso el código, la descripción del producto y otras características que necesito, al ingresar los datos en esta hoja y darle click a un botón la macro copia los datos y los pega en la base de datos del inventario hasta ahi no tengo problemas el caso es que trate de modificar el código de la macro para que estos datos no se pasen o copien a la base de datos si el código que ingreso y muestra un mensaje de error y me regresa al campo código para cambiar el mismo, bueno al parecer el código esta bien (hasta donde yo lo veo) pero no import el código que escriba siempre me da error y no me deja ingresar nuevos artículos a continuación le dejo el código que estoy utilizando y que me da error espero que me puedan ayudar, este es el código de la macro:
Sub Ingresar_Inventario()
'obtiene la última fila de la hoja Catálogo Inventario
uf = Sheets("Catálogo Inventario").Range("A" & Rows.Count).End(xlUp).Row
'Declarar CodErr en caso de error
CodErr = 0
'Busca código en la hoja Catálogo Inventario
Set b = Sheets("Catálogo Inventario").Range("A1:A" & uf).Find(Sheets("Crear Material").Range("C5"))
'Si no encuentra el código
If b Is Nothing Then
'Si Código no es igual
If Sheets("Crear Material").Range("C5") <> Sheets("Catálogo Inventario").Cells(b.Row, "A") Then
'Selecciona los datos a copiar
Sheets("Crear Material").Select
Range("C5:C10").Copy
'Selecciona la ultima celda para copiar los datos
Sheets("Catálogo Inventario").Select
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
'Pega los datos seleccionados
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Regresa al formulario de ingreso limpia el contenido y se se posiciona en el primer campo para ingresar un nuevo registro
Sheets("Crear Material").Select
Sheets("Crear Material").Range("C5:C8").ClearContents
Range("C5").Select
Else
CodErr = 1
End If
Else
CodErr = 1
End If
If CodErr = 1 Then
MsgBox ("Código ya Existe!!!, Por Favor Ingrese un Código Diferente")
Sheets("Crear Material").Range("C5").ClearContents
Sheets("Crear Material").Select
Range("C5").Select
End If
End Sub
Espero puedan ayudarme muchas gracias y un saludo desde Honduras
1 Respuesta
Te regreso la macro
Sub Ingresar_Inventario()
'Mod.Por.DAM
'obtiene la última fila de la hoja Catálogo Inventario
uf = Sheets("Catálogo Inventario").Range("A" & Rows.Count).End(xlUp).Row
'Declarar CodErr en caso de error
CodErr = 0
'con esta rutina se busca el material para indicar si ya existe
mat = Sheets("Crear Material").Range("C5")
Set r = Sheets("Catálogo Inventario").Range("A1:A" & uf)
Set b = r.Find(mat)
If Not b Is Nothing Then
ncell = b.Address
Do: Set b = r.FindNext(b)
If mat = b Then CodErr = 1
Loop While Not b Is Nothing And b.Address <> ncell
End If
If CodErr = 1 Then
MsgBox ("Código ya Existe!!!, Por Favor Ingrese un Código Diferente")
Sheets("Crear Material").Range("C5").ClearContents
Range("C5").Select
Else
'Selecciona los datos a copiar
Sheets("Crear Material").Range("C5:C10").Copy
'Selecciona la ultima celda para copiar los datos
Sheets("Catálogo Inventario").Range("A" & uf + 1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
'Limpia el contenido y se posiciona en el primer campo
Sheets("Crear Material").Range("C5:C8").ClearContents
Range("C5").Select
End If
End Sub Saludos.DAM
No olvides finalizar la pregunta.
