Corrección a un sector de Macro

Este es el padazxo que quiero corregir para que SOLO en columna B.

¿Qué la A se repite? No importa que se repita en A pero no en B

Private Sub cbtNueClien_Click()
    On Error Resume Next
    Dim fila As Integer
    Set ws = ActiveSheet
    If cboHojas.Value = "" Then
        MsgBox "NO HA SELECCIONADO HOJA"
        Exit Sub
    Else
'Viene de la Function valida(wtext As MSForms.Control, num)
    If MINCaracter(txtCod, "Cod/Producto", 10) = False Then Exit Sub ''AQUI 10 DIGITOS MINIMO y MAX
''''''''''''''
    If Application.CountIf(ActiveSheet.Range("B2:B50000"), txtProd.Value) Then 'Busca en la columna A si existe el contacto
Rem Si existe la rutina llega solo al If mensage. si no existe, brinca después de Else para insertar los datos.
        Mensage = MsgBox("El producto " & txtProd.Text & " ya existe." & vbCrLf & vbCrLf & _
                "Puede escribir nuevo nombre y seguir, o en otro proceso editar datos", vbInformation + vbOKOnly, "CONTACTO EXISTENTE")
        txtProd.Text = "" 'Si manda mensaje, Limpia el TextBox (txtProd)
        If Mensage = vbOK Then Exit Sub 'Del mensaje presionas OK y hasta el Exit Sub llega la rutina
    Else
'''''''''''''
'Inserta datos de nuevo cliente
    With ws
       fila = .Range("A2:A25000").Find(txtCod, lookat:=xlWhole).Row
       If Err.Number = 91 Then
          fila = .Range("b" & .Rows.Count).End(xlUp)(2).Row
          Call ingresar_datos(fila)
          Exit Sub
       End If
       Call ingresar_datos(fila)
    End With
    End If
    End If
    Buscar.Enabled = False
End Sub

Como está la macro no f8nciona de la manera que pretendo.

Ya elimine sobre la A y no me funciona hasta que tuve que recurrir a otr olibro para colocar la macro como inicialmente estaba.

1 Respuesta

Respuesta
1

Puedes explicar con un ejemplo.

En la hoja se ve que ya existe el código y nombre igual

El botón de Validar producto (Private Sub cbtNueClien_Click() ) que no permita repetición de nombre, pero si permita la repetición de código. Para que obligue a dar un nombre diferente o salga de la macro después que el mensaje te dice que ya existe igual nombre, cambie el nombre, o salga de la macro

El boton de edicion (Private Sub cbtEdCli_Click() ) de igual forma no permita repeticion de nombre, pero si permita la repeticion de código.

Si acepta cambiar el nombre, SOLO limpia el txtProd (nombre de producto) y sigues, si no acepta sale de la macro.

Para editar un producto, se selecciona uno del listBox y rellena todos los cuadros de texto y el txtCod aparece False para que no se pueda cambiar.

Es de agradecerte tu paciencia, no se si mi explicación t es clara o necesitas de algo más, tal vez soy un tanto perco en explicar las cosas, trato lo mejor posible.

Gracias

La macro de edición

Private Sub cbtEdCli_Click() 'Valida Edicion
    On Error Resume Next
    Dim fila As Integer
    Set ws = ActiveSheet
    With ws
       fila = .Range("A2:A25000").Find(txtCod, lookat:=xlWhole).Row
       If Err.Number = 91 Then
          fila = .Range("B" & .Rows.Count).End(xlUp)(2).Row
        Call ingresar_EdCli(fila)
        Exit Sub
    End If
        Call ingresar_EdCli(fila)
    End With
    'Buscar.Enabled = False
End Sub

Explica, qué debe hacer la macro, en cada una de las siguientes situaciones:

1. NO existe el código y NO existe el nombre.

2. NO existe el código y existe el nombre.

3. existe el código y existe el nombre.

4. existe el código y NO existe el nombre.

1. NO existe el código y NO existe el nombre. = seguir con la macro

2. NO existe el código y existe el nombre. = Debe mandar mensaje para poder cambiar el nombre o terminar la macro. Ej. MsgBox = " desea cambiar nombre? o  terminar la macro?"

En el MsgBox Si le digo, Cacelar, limpia el cuadro de nombre para escribir nuevo nombre.

Si le digo SI, terminar la macro. (El punto 2 verás cual va, Cancelar, si SI o NO, o si NO o SI

3. existe el código y existe el nombre. = igual que el punto 2  aunque exista el código. Se puede repetir SOLO el código, NO el nombre.

4. existe el código y NO existe el nombre. = seguir con la macro.

¿Por qué esto? MsgBox = " desea cambiar nombre? o  terminar la macro?"

Porque en el libro también hay un form para dar entrada o salida a productos con mismo nombre, y código que solo agrega Cantidad en entrada o salida

Por eso para Editar (2º botón en el form frmProd) aparecen desactivadas las cajas de texto Código, Nombre producto y Cantidad si no no tendría sentido el otro form para entrada y salida

Gracias dante por tu paciencia y ayuda desinteresada

Prueba esto:

Private Sub cbtNueClien_Click()
  Dim ws As Worksheet
  Dim f As Range
  Dim fila As Long
  Dim respuesta As Variant
  '
  Set ws = ActiveSheet
  If cboHojas.Value = "" Then
    MsgBox "NO HA SELECCIONADO HOJA"
    Exit Sub
  End If
  '
  With ws
    'Viene de la Function valida(wtext As MSForms.Control, num)
    If MINCaracter(txtCod, "Cod/Producto", 10) = False Then Exit Sub ''AQUI 10 DIGITOS MINIMO y MAX
    If Application.CountIf(.Range("B:B"), txtProd.Value) Then 'Busca en la columna A si existe el contacto
      respuesta = MsgBox("El producto " & txtProd.Text & " ya existe." & vbCrLf & vbCrLf & _
      "Desea cambiar nombre", vbQuestion + vbYesNo, "CONTACTO EXISTENTE")
      If respuesta = vbYes Then
        txtProd.Text = "" 'Si manda mensaje, Limpia el TextBox (txtProd)
        txtProd.SetFocus
        Exit Sub
      Else
        End
      End If
    End If
    'Inserta datos de nuevo cliente
    Set f = .Range("A:A").Find(txtCod, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      fila = f.Row
    Else
      fila = .Range("A" & .Rows.Count).End(xlUp)(2).Row
    End If
    Call ingresar_datos(fila)
  End With
  Buscar.Enabled = False
End Sub

Hola dante. En este caso, en la macro enviada m sucede esto

¿Qué puedo hacer aquí? Para mi es desconocido

Pregunto si el detalle de que me machuca la línea donde exista un código ya existente

    With ws
       fila = .Range("A2:A50000").Find(txtCod, lookat:=xlWhole).Row
       If Err.Number = 91 Then
       fila = .Range("b" & .Rows.Count).End(xlUp)(2).Row
          Call ingresar_datos(fila)
          Exit Sub
       End If
       Call ingresar_datos(fila)
    End With

Porque al ingresar nuevo en que ecribo un codigo ya existente sin saberlo, le doy al boton nuevo producto (cbtNueClien) y me lo coloca EN LA LINEA donde ya existe uno con el mismo codigo.

Queda el mismo código, escrito inocentemente sin saber que ya existe dichpo código pero el nombre y demás lo cambia si lo escribo diferente al de la línea ya existente

No te entiendo.

Debes reemplazar tu código Private Sub cbtNueClien_Click() por mi código.

Si lo hice

Si prefieres te envío el libro

deja tu mail

No sé cómo tienes declarada la variable fila o cómo está en tu macro "ingresar_datos"

Prueba lo siguiente, cambia la variable fila por n.

Private Sub cbtNueClien_Click()
  Dim ws As Worksheet
  Dim f As Range
  Dim n As Long
  Dim respuesta As Variant
  '
  Set ws = ActiveSheet
  If cboHojas.Value = "" Then
    MsgBox "NO HA SELECCIONADO HOJA"
    Exit Sub
  End If
  '
  With ws
    'Viene de la Function valida(wtext As MSForms.Control, num)
    If MINCaracter(txtCod, "Cod/Producto", 10) = False Then Exit Sub ''AQUI 10 DIGITOS MINIMO y MAX
    If Application.CountIf(.Range("B:B"), txtProd.Value) Then 'Busca en la columna A si existe el contacto
      respuesta = MsgBox("El producto " & txtProd.Text & " ya existe." & vbCrLf & vbCrLf & _
      "Desea cambiar nombre", vbQuestion + vbYesNo, "CONTACTO EXISTENTE")
      If respuesta = vbYes Then
        txtProd.Text = "" 'Si manda mensaje, Limpia el TextBox (txtProd)
        txtProd.SetFocus
        Exit Sub
      Else
        End
      End If
    End If
    'Inserta datos de nuevo cliente
    Set f = .Range("A:A").Find(txtCod, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      n = f.Row
    Else
      n = .Range("A" & .Rows.Count).End(xlUp)(2).Row
    End If
    Call ingresar_datos(n)
  End With
  Buscar.Enabled = False
End Sub


Si tienes problemas, entonces pon aquí todo tu código.

La macro funciona para mí.

Private Sub cbtNueClien_Click()
    On Error Resume Next
    Dim fila As Integer
    Set ws = ActiveSheet
    If cboHojas.Value = "" Then
        MsgBox "NO HA SELECCIONADO HOJA"
        Exit Sub
    Else
'Viene de la Function valida(wtext As MSForms.Control, num)
    If MINCaracter(txtCod, "Cod/Producto", 10) = False Then Exit Sub ''AQUI 10 DIGITOS MINIMO
''''''''''''''
    If Application.CountIf(ActiveSheet.Range("B2:B50000"), txtProd.Value) Then 'Busca en la columna A si existe el contacto
Rem Si existe la rutina llega solo al If mensage. si no existe, brinca después de Else para insertar los datos.
        Mensage = MsgBox("El producto " & txtProd.Text & " ya existe." & vbCrLf & vbCrLf & _
                "Puede escribir nuevo nombre y seguir, o en otro proceso editar datos", vbInformation + vbOKOnly, "CONTACTO EXISTENTE")
        txtProd.Text = "" 'Si te dá mensage, Limpia el TextBox
        If Mensage = vbOK Then Exit Sub 'Del mensage presionas OK y hasta el Exit Sub llega la rutina
    Else
''''
'Inserta datos de nuevo cliente
    With ws
       fila = .Range("A2:A25000").Find(txtCod, lookat:=xlWhole).Row
       If Err.Number = 91 Then
          fila = .Range("b" & .Rows.Count).End(xlUp)(2).Row
          Call ingresar_datos(fila)
          Exit Sub
       End If
       Call ingresar_datos(fila)
    End With
    End If
    End If
    Buscar.Enabled = False
End Sub
'---------------------- --------------------------------- ----------------------
'Inserta y luego ordena alfabeticamente de B hasta G tomando columna B
Sub ingresar_datos(fila As Integer, Optional OrdenarPor As String = "B") 'Ordena por la columna B
    Set ws = ActiveSheet
    Application.ScreenUpdating = False
    With ws
        .Cells(fila, 1) = txtCod
        .Cells(fila, 2) = txtProd
        .Cells(fila, 3) = txtProve
        .Cells(fila, 4) = txtFactu
        .Cells(fila, 5) = Format(DTPicker1, "mm/dd/yyyy") 'DTPicker1 en ves de txtFFact
'        .Cells(fila, 5) = NumberFormat = "dd/mm/yyyy" 'dar formato a la celda
        .Cells(fila, 6) = CDbl(txtUbic.Value)
        .Cells(fila, 7) = txtObser
        .Range("A2:G" & fila).Sort key1:=.Range(OrdenarPor & fila)
    End With
    Application.ScreenUpdating = True
'limpiar controles
    Call Limpar(Me)
'carga ListBox
    Call BuscaCambio
    Call actualizar_lista
    Call contador(Me)
        Range(Cells(Selection.Row, 1), Cells(Selection.Row, 7)).Select
    'Range("A2").Select
    txtCod.SetFocus
End Sub

Buen día Dante. Este es el código integro que me dejaste En ingresar datos le cambie fila por nen el código también en ingresar datos

En prencipio m dyo este error, le cabie Integer por range en la variable y paso a mencionar este

Le respondo Si y cambio el nombre le doy a boton ingresar nuevo, me acusa acá,

Repito el código pero le cambio el nombre como menciono arriba le doy a ingresa renuevo y me reemplaza toda la línea como se ve la ultima línea de las 2 imágenes ultimas 2 imágenes

Pero no veo que hayas reemplazado tu código por el mío.

Intenta nuevamente, quita tu código y pon el mío

Private Sub cbtNueClien_Click()
  Dim ws As Worksheet
  Dim f As Range
  Dim n As Long
  Dim respuesta As Variant
  '
  Set ws = ActiveSheet
  If cboHojas.Value = "" Then
    MsgBox "NO HA SELECCIONADO HOJA"
    Exit Sub
  End If
  '
  With ws
    'Viene de la Function valida(wtext As MSForms.Control, num)
    If MINCaracter(txtCod, "Cod/Producto", 10) = False Then Exit Sub ''AQUI 10 DIGITOS MINIMO y MAX
    If Application.CountIf(.Range("B:B"), txtProd.Value) Then 'Busca en la columna A si existe el contacto
      respuesta = MsgBox("El producto " & txtProd.Text & " ya existe." & vbCrLf & vbCrLf & _
      "Desea cambiar nombre", vbQuestion + vbYesNo, "CONTACTO EXISTENTE")
      If respuesta = vbYes Then
        txtProd.Text = "" 'Si manda mensaje, Limpia el TextBox (txtProd)
        txtProd.SetFocus
        Exit Sub
      Else
        End
      End If
    End If
    'Inserta datos de nuevo cliente
    Set f = .Range("A:A").Find(txtCod, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      n = f.Row
    Else
      n = .Range("A" & .Rows.Count).End(xlUp)(2).Row
    End If
    Call ingresar_datos(n)
  End With
  Buscar.Enabled = False
End Sub

Y también cambia esta línea 

Sub ingresar_datos(fila As Integer, Optional OrdenarPor As String = "B")

Por esta línea:

Sub ingresar_datos(fila As Long, Optional OrdenarPor As String = "B")

Todo esto lo tienes que borrar

Private Sub cbtNueClien_Click()
    On Error Resume Next
    Dim fila As Integer
    Set ws = ActiveSheet
    If cboHojas.Value = "" Then
        MsgBox "NO HA SELECCIONADO HOJA"
        Exit Sub
    Else
'Viene de la Function valida(wtext As MSForms.Control, num)
    If MINCaracter(txtCod, "Cod/Producto", 10) = False Then Exit Sub ''AQUI 10 DIGITOS MINIMO
''''''''''''''
    If Application.CountIf(ActiveSheet.Range("B2:B50000"), txtProd.Value) Then 'Busca en la columna A si existe el contacto
Rem Si existe la rutina llega solo al If mensage. si no existe, brinca después de Else para insertar los datos.
        Mensage = MsgBox("El producto " & txtProd.Text & " ya existe." & vbCrLf & vbCrLf & _
                "Puede escribir nuevo nombre y seguir, o en otro proceso editar datos", vbInformation + vbOKOnly, "CONTACTO EXISTENTE")
        txtProd.Text = "" 'Si te dá mensage, Limpia el TextBox
        If Mensage = vbOK Then Exit Sub 'Del mensage presionas OK y hasta el Exit Sub llega la rutina
    Else
''''
'Inserta datos de nuevo cliente
    With ws
       fila = .Range("A2:A25000").Find(txtCod, lookat:=xlWhole).Row
       If Err.Number = 91 Then
          fila = .Range("b" & .Rows.Count).End(xlUp)(2).Row
          Call ingresar_datos(fila)
          Exit Sub
       End If
       Call ingresar_datos(fila)
    End With
    End If
    End If
    Buscar.Enabled = False
End Sub

Y pones el nuevo código que te envié.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas