Macro para eliminar de ListBox y hojas marca error

jose lopez contreras · el 21 de marzo

Hoja amigos, les traigo a ustedes este error que me marca una macro, cabe decir que algunas macros las encontré en este foro y las adapte a mis necesidades. Les platico.

la siguiente macro la tengo en un botón, el cual al dar clic llama a un userform

Private Sub CommandButton6_Click()
    EliminarFilas2.Show
End Sub

en ese userform hay que poner una contraseña para poder eliminar

Private Sub CommandButton1_Click()
Dim resp As Integer
    resp = 3313
    If TextBox1 = 3313 Then
Unload Me
'Tu procedimiento aquí
Call Busqueda_Resguardo.eliminarProducto
    Else
        MsgBox ("La clave ingresada es incorrecta"), vbInformation, "AVISO"
            TextBox1 = Clear
        TextBox1.SetFocus
    End If
End Sub

al dar clic debería ,eliminar del listbox y hojas pero me arroja un error.

Sub eliminarProducto()

'Borrar del ListBox y de las hojas

Dim sino As String
    sino = MsgBox("Estás seguro de Eliminar el Articulo seleccionado?", vbYesNo + vbQuestion, "CONFIRMA")
    If sino <> vbYes Then Exit Sub

Dim fila As Integer
Dim Final As Integer
Dim Cantidad As Integer
''''AQUI REGISTRO EL CORRELATIVO FINAL PROCESADO

Dim NombreHoja As String
NombreHoja = "Inventario"
'Buscamos la última fila
'EN EL SIGUIENTE ME ESTOY REFIRIENDO A LA HOJA SEGUN EL SECTOR
    fila = 2
    Do While ThisWorkbook.Sheets(NombreHoja).Cells(fila, 1) <> ""
        fila = fila + 1
    Loop
    Final = fila

    'CON ESTE CODIGO ESTARE RESTANDO "1" AL FOLIO EN CASO SE REGRESE A LA VENTANA ANTERIOR
    For fila = 2 To Final
        If ThisWorkbook.Sheets(NombreHoja).Cells(fila, 1) = ListBox1.Column(0) Then 'CORRESPONDE A LA COLUMNA "A"
           ThisWorkbook.Sheets(NombreHoja).Cells(fila, 8) = ThisWorkbook.Sheets(NombreHoja).Cells(fila, 7) - Val(ListBox1.Column(5))
            Exit For
        End If
    Next
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim row_LB&

With ListBox1
  row_LB = .ListIndex
  If row_LB = -1 Then Exit Sub
  .RemoveItem row_LB
  .ListIndex = -1
End With

With Sheets("Salidas")
  .Range("a2:n2").Offset(row_LB).Delete xlShiftUp
End With

With Sheets("Temporal")
  .Range("a2:n2").Offset(row_LB).Delete xlShiftUp
End With

With Sheets("Resguardo")
  .Range("a2:i2").Offset(row_LB).Delete xlShiftUp
End With

With Sheets("Stock")
  .Range("a2:n2").Offset(row_LB).Delete xlShiftUp
End With

    MsgBox "Selección eliminada"

End Sub

de esta ultima macro me corre solo hasta aquí:

    sino = MsgBox("Estás seguro de Eliminar el Articulo seleccionado?", vbYesNo + vbQuestion, "CONFIRMA")
    If sino <> vbYes Then Exit Sub

y es justo ahí es donde salta error pero en la segunda macro que coloque en esta parte

Call Busqueda_Resguardo.eliminarProducto

Se que es mucho rollo pero espero y me ayuden

JSDJSD · el 21 de marzo

El error que te marca en tu macro (eliminarProducto) lo tienes localizado en lo que te he apostrofado, ya que no tienes dicha hoja. Eliminalo o comentalo y prueba haber si te funciona.

jose lopez contreras · el 21 de marzo

Hace 14 minutos , JSDJSD dijo:

El error que te marca en tu macro (eliminarProducto) lo tienes localizado en lo que te he apostrofado, ya que no tienes dicha hoja. Eliminalo o comentalo y prueba haber si te funciona.

Gracias amigo por tu pronta respuesta, pero te comento que la hoja se genera automáticamente. Te dejo el archivo para que lo análisis y me des tus recomendaciones.

https://mega.nz/#!rN5DXYrK!JQvY_1J2Xz_dVMUZKMrnYDJm5csFjObWzHvV2X61sOE

jose lopez contreras · el 22 de marzo

@JSDJSD verdad que esta algo raro, mira coloque esto " On Error Resume Next " al inicio de la macro eliminarProducto para evitar el error, corre bien la macro pero no elimina las hojas indicadas.

rolano · el 22 de marzo

Hola José, al principio llenas el listbox con datos de la hoja inventario, luego llenas el listbox con la hoja temporal, el index del combobox cambia, y no puedes borrar datos de otra hoja con index que no le corresponde. Analiza bien tu programación.

Saludos,

jose lopez contreras · el 22 de marzo

Hace 1 hora, rolano dijo:

Hola José, al principio llenas el listbox con datos de la hoja inventario, luego llenas el listbox con la hoja temporal, el index del combobox cambia, y no puedes borrar datos de otra hoja con index que no le corresponde. Analiza bien tu programación.

Tienes toda la razón amigo, probé quitando la creación de la hoja temporal y ahora si elimina la fila correspondiente de la hoja pero ahora del ListBox no se elimina la fila seleccionada, ya que la hoja temporal era para ello, como podre hacer ahora que se borre del ListBox.

Alfonso5597 · el 23 de marzo

Hola amigo, te mando mi solucion, con mucho menos codigo, claro esta hay que adaptarlo a tu trabajo, espero que te sirva

Saludos

Eliminar datos de listbox.xlsm

rolano · el 25 de marzo


Private Sub CommandButton2_Click()
On Error Resume Next
Dim b As Object
Dim a As Object
Dim dato0
Dim dato1
Dim dato2
Dim fila As Integer
Dim i As Integer
Dim uf As String
Dim uc As String
Dim wc As String
Dim strg As String

Set b = Sheets("Resguardo")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
dato1 = VBA.CDate(TextBox2)
dato2 = VBA.CDate(TextBox3)
If dato2 = "" Or dato1 = "" Then
MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO"
Exit Sub
End If
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = "Clear"
Me.ListBox1.RowSource = "Clear"

'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("Temporal").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Temporal"
Set a = Sheets("Temporal")
b.Range("A1:I1").Copy Destination:=a.Range("A1")
fila = 2

If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If

For i = 2 To uf
   strg = b.Cells(i, 7).Value
   dato0 = VBA.CDate(b.Cells(i, 6).Value)
   If VBA.UCase(strg) Like VBA.UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 Then
       a.Cells(fila, 1) = b.Cells(i, 1)
       a.Cells(fila, 2) = b.Cells(i, 2)
       a.Cells(fila, 3) = b.Cells(i, 3)
       a.Cells(fila, 4) = b.Cells(i, 4)
       a.Cells(fila, 5) = b.Cells(i, 5)
       a.Cells(fila, 6) = VBA.Format(b.Cells(i, 6), "mm/dd/yyyy;@")
       a.Cells(fila, 7) = b.Cells(i, 7)
       a.Cells(fila, 8) = b.Cells(i, 8)
       a.Cells(fila, 9) = b.Cells(i, 9)
       fila = fila + 1

   End If
Next i


a.Range("I").NumberFormat = VBA.Format("dd/mm/yyyy")

With Sheets("Temporal")
  ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value
End With

TextBox1.SetFocus
End Sub
Private Sub CommandButton3_Click()
Dim sino As String

sino = MsgBox("Estas seguro de cerrar la Busqueda de Resguardo, antes debes guardar?", vbYesNo + vbQuestion, "CONFIRMA")
If sino <> vbYes Then Exit Sub
Application.ScreenUpdating = False
    Application.Visible = False
'Application.Windows(ThisWorkbook.Name).Visible = False
Worksheets("Temporal").Select
Worksheets("Temporal").Delete
Unload Me
'Menu.Show
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton4_Click()
Dim h1 As Object
Dim C As Integer
Dim f As Integer

    Set h1 = Sheets("ReporteResguardo")
h1.Rows("2:" & Rows.Count).ClearContents
    C = ListBox1.ColumnCount
    f = ListBox1.ListCount
h1.Range(h1.Cells(2, "A"), h1.Cells(f + 1, C)) = ListBox1.List
MsgBox ("Los datos se copiaron con éxito"), vbInformation, "AVISO"
CommandButton3.Visible = True
End Sub

Private Sub CommandButton5_Click()
Application.Help ThisWorkbook.Path & "\Ayuda.chm"
End Sub

Private Sub CommandButton6_Click()
    EliminarFilas2.Show
End Sub

Private Sub DTPicker1_Change()
   TextBox2 = DTPicker1
End Sub

Private Sub DTPicker2_Change()
   TextBox3 = DTPicker2
End Sub

Private Sub ListBox1_Click()
    CommandButton6.Visible = True
End Sub

Private Sub TextBox1_Change()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Dim b As Object
Dim a As Object
Dim dato0
Dim dato1
Dim dato2
Dim fila As Integer
Dim i As Integer
Dim uf As String
Dim uc As String
Dim wc As String
Dim strg As String

Set b = Sheets("Resguardo")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If VBA.Trim(TextBox1.Value) = "" Then
        With Sheets("Resguardo")
        ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value
        End With

   Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = "Clear"
Me.ListBox1.RowSource = "Clear"
dato1 = VBA.CDate(TextBox2)
dato2 = VBA.CDate(TextBox3)

'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("Temporal").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Temporal"
Set a = Sheets("Temporal")
b.Range("A1:I1").Copy Destination:=a.Range("A1")
fila = 2
For i = 2 To uf
   strg = b.Cells(i, 7).Value
   If VBA.UCase(strg) Like VBA.UCase(TextBox1.Value) & "*" Then
       a.Cells(fila, 1) = b.Cells(i, 1)
       a.Cells(fila, 2) = b.Cells(i, 2)
       a.Cells(fila, 3) = b.Cells(i, 3)
       a.Cells(fila, 4) = b.Cells(i, 4)
       a.Cells(fila, 5) = b.Cells(i, 5)
       a.Cells(fila, 6) = VBA.Format(b.Cells(i, 6), "mm/dd/yyyy;@")
       a.Cells(fila, 7) = b.Cells(i, 7)
       a.Cells(fila, 8) = b.Cells(i, 8)
       a.Cells(fila, 9) = b.Cells(i, 9)
       fila = fila + 1
   End If
Next i


a.Range("I").NumberFormat = VBA.Format("dd/mm/yyyy")

With Sheets("Temporal")
  ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value
End With

End Sub

Private Sub UserForm_Initialize()
'Dim b As Object
'Dim uf As Integer
'Dim uc, wc As String
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False

With Sheets("Resguardo")
  ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Al iniciar el formulario asignamos un mensaje tooltip al botón,
'así como un ícono personalizado para ser mostrado en over
    Me.CommandButton5.ControlTipText = "Mostrar la ayuda de este formulario."
    Me.CommandButton5.MousePointer = fmMousePointerHelp
    CommandButton3.Visible = False
    CommandButton6.Visible = False
End Sub
'
'Evita Cerrar La Ventana
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
            MsgBox "Use el botón Cerrar del formulario", vbInformation, " Botón No Disponible "
         Cancel = 1
        CloseMode = 1
    End If
End Sub

Private Sub UserForm_Activate()
    Application.ScreenUpdating = False
    Application.Visible = False
        TextBox1 = Empty
        TextBox1.SetFocus
              Application.ScreenUpdating = True
'            DTPicker1.Value = VBA.Date
'            TextBox2.Value = DTPicker1.Value
'        DTPicker2.Value = VBA.Date
'        TextBox3.Value = DTPicker2.Value
    CommandButton3.Visible = False
    CommandButton6.Visible = False
End Sub
Sub eliminarProducto()

'Borrar del ListBox y de las hojas
On Error Resume Next

Dim sino As String
    sino = MsgBox("Estás seguro de Eliminar el Articulo seleccionado?", vbYesNo + vbQuestion, "CONFIRMA")
    If sino <> vbYes Then Exit Sub

Dim fila As Integer
Dim Final As Integer
Dim Cantidad As Integer
''''AQUI REGISTRO EL CORRELATIVO FINAL PROCESADO
Application.ScreenUpdating = False
Dim NombreHoja As String
NombreHoja = "Inventario"
'Buscamos la última fila
'EN EL SIGUIENTE ME ESTOY REFIRIENDO A LA HOJA SEGUN EL SECTOR
    fila = 2
    Do While ThisWorkbook.Sheets(NombreHoja).Cells(fila, 1) <> ""
        fila = fila + 1
    Loop
    Final = fila

    'CON ESTE CODIGO ESTARE RESTANDO "1" AL FOLIO EN CASO SE REGRESE A LA VENTANA ANTERIOR
    For fila = 2 To Final
        If ThisWorkbook.Sheets(NombreHoja).Cells(fila, 1) = ListBox1.List(ListBox1.ListIndex, 0) Then 'CORRESPONDE A LA COLUMNA "A"
           ThisWorkbook.Sheets(NombreHoja).Cells(fila, 8) = ThisWorkbook.Sheets(NombreHoja).Cells(fila, 7) - Val(ListBox1.List(ListBox1.ListIndex, 5))
            Exit For
        End If
    Next
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim row_LB&
With Busqueda_Resguardo.ListBox1
  row_LB = .ListIndex
  If row_LB = -1 Then Exit Sub
  


Hoja3.Activate
    ' Se busca por numero de la Fact en el listbox1
    If Hoja3.Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then
        CeldaFact = ActiveCell.Text
        If CeldaFact = .List(row_LB, 0) Then
           
            Cells(ActiveCell.Row, "A").EntireRow.Delete
        End If
    End If
    
    Sheets("Temporal").Activate
    ' Se busca por numero de la Fact en el listbox1
    If Sheets("Temporal").Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then
        CeldaFact = ActiveCell.Text
        If CeldaFact = .List(row_LB, 0) Then
            Cells(ActiveCell.Row, "A").EntireRow.Delete
        End If
    End If

Hoja10.Activate
    ' Se busca por numero de la Fact en el listbox1
    If Hoja10.Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then
        CeldaFact = ActiveCell.Text
        If CeldaFact = .List(row_LB, 0) Then
            Cells(ActiveCell.Row, "A").EntireRow.Delete
        End If
    End If

Hoja5.Activate
    ' Se busca por numero de la Fact en el listbox1
    If Hoja5.Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then
        CeldaFact = ActiveCell.Text
        If CeldaFact = .List(row_LB, 0) Then
            Cells(ActiveCell.Row, "A").EntireRow.Delete
        End If
    End If

.RemoveItem row_LB
    .ListIndex = -1
End With

'With Sheets("Salidas")
'  .Range("a2:n2").Offset(row_LB).Delete xlShiftUp
'End With
'
'With Sheets("Temporal")
'  .Range("a2:n2").Offset(row_LB).Delete xlShiftUp
'End With
'
'With Sheets("Resguardo")
'  .Range("a2:i2").Offset(row_LB).Delete xlShiftUp
'End With
'
'With Sheets("Stock")
'  .Range("a2:n2").Offset(row_LB).Delete xlShiftUp
'End With
'
Application.ScreenUpdating = True
    MsgBox "Selección eliminada"

End Sub

Hola Alfonso, pega estos codigos en el userform Busqueda_Resguardo. Recuerda que el numero de factura debe ser igual y única en todas las hojas.

Saludos,

César

jose lopez contreras · el 25 de marzo

En 23/3/2019 at 11:25 , Alfonso5597 dijo:

Hola amigo, te mando mi solucion, con mucho menos codigo, claro esta hay que adaptarlo a tu trabajo, espero que te sirva

Hola amigo mira al adaptar tus instrucciones me arroja un error que dice " Se requiere un objeto " las instrucciones en mi proyecto quedo asi tomando tu ejemplo, cabe mencionar que el ListBox1 esta configurado igual al tuyo. OJO en esta parte " ListBox1.RowSource = "'" & .Name & "'!A2:I" & .Range("A" & Rows.Count).End(xlUp).Row ' OJO aqui es donde se detiene la macro "

Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set h1 = Sheets("Resguardo")
'Worksheets("Resguardo").Select
With ListBox1
    .ColumnHeads = True
    .ColumnCount = 9
'    .ColumnWidths = "70;55;55;160;60;60;60;60;48;55;70;75;130;180;200;90;45;130;100;70;70;110;130;110;70;80;140"
End With
Cargar

Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Al iniciar el formulario asignamos un mensaje tooltip al botón,
'así como un ícono personalizado para ser mostrado en over
    Me.CommandButton5.ControlTipText = "Mostrar la ayuda de este formulario."
    Me.CommandButton5.MousePointer = fmMousePointerHelp
    CommandButton3.Visible = False
    CommandButton6.Visible = False
End Sub

Private Sub Cargar()
With h1
    ListBox1.RowSource = "'" & .Name & "'!A2:I" & .Range("A" & Rows.Count).End(xlUp).Row ' OJO aqui es donde se detiene la macro
End With
End Sub

jose lopez contreras · el 25 de marzo

@Alfonso5597 ya encontré mi error faltaba declarar la hoja h1, ahora si funciona bien, pero tengo que eliminar en dos hoja como puedo adaptar esta parte para poder hacerlo si h1 es Resguardo y h2 es Salidas

Private Sub CommandButton3_Click()
Dim Rango As Range
With ListBox1
   For x = 0 To .ListCount - 1
      If .Selected(x) Then
         If Rango Is Nothing Then
            Set Rango = H1.Rows(x + 2)
         Else
            Set Rango = Union(Rango, H1.Rows(x + 2))
         End If
      End If
   Next
End With
If Not Rango Is Nothing Then
   Rango.Delete
   Cargar
End If
End Sub