Actualización masiva de datos vba
Tengo una macro que me permite actualizar, borrar y buscar datos (en este caso el filtro es uno solo) ¿Cómo podría hacer una función para poder cambiar de filtro? Es decir, tener tal vez un listbox que me permita cambiar de filtro...
Esta es la macro de los botones:
Option Explicit
Dim ArchivoIMG As String
Private Sub cmd_Agregar1_Click()
Dim i As Integer
If cbo_Nombre.Text = "" Then
MsgBox "Invalid Name", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
Sheets("List").Activate
Dim fDatos As Integer
fDatos = nDatos(cbo_Nombre.Text)
If fDatos = 0 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
Else
Cells(fDatos, 1).Select
End If
Application.ScreenUpdating = False
ActiveCell = cbo_Nombre
ActiveCell.Offset(0, 1) = txt_Vendor
ActiveCell.Offset(0, 2) = txt_Adress
ActiveCell.Offset(0, 3) = txt_Name
ActiveCell.Offset(0, 4) = txt_Planner
ActiveCell.Offset(0, 5) = txt_sqe
ActiveCell.Offset(0, 6) = txt_sesa
Application.ScreenUpdating = True
LimpiarFormulario
cbo_Nombre.SetFocus
End Sub
Private Sub cmd_Eliminar1_Click()
Dim fDatos As Integer
fDatos = nDatos(cbo_Nombre.Text)
If fDatos = 0 Then
MsgBox "The Part Number you want to remove does not exist", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
If MsgBox("Are you sure you want to delete this Part Number?", vbQuestion + vbYesNo) = vbYes Then
Cells(fDatos, 1).Select
ActiveCell.EntireRow.Delete
LimpiarFormulario
MsgBox "Part number removed", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
End If
End Sub
Private Sub cmd_Cerrar1_Click()
End
End Sub
Private Sub cbo_Nombre_Change()
On Error Resume Next
If nDatos(cbo_Nombre.Text) <> 0 Then
Sheets("List").Activate
Cells(cbo_Nombre.ListIndex + 2, 1).Select
txt_Vendor = ActiveCell.Offset(0, 1)
txt_Adress = ActiveCell.Offset(0, 2)
txt_Name = ActiveCell.Offset(0, 3)
txt_Planner = ActiveCell.Offset(0, 4)
txt_sqe = ActiveCell.Offset(0, 5)
txt_sesa = ActiveCell.Offset(0, 6)
Else
txt_Vendor = ""
txt_Adress = ""
txt_Name = ""
txt_Planner = ""
txt_sqe = ""
txt_sesa = ""
End If
End Sub
Private Sub cbo_Nombre_Enter()
CargarLista
End Sub
Sub CargarLista()
cbo_Nombre.Clear
Sheets("List").Select
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
cbo_Nombre.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub LimpiarFormulario()
CargarLista
cbo_Nombre = ""
txt_Vendor = ""
txt_Adress = ""
txt_Name = ""
txt_Planner = ""
txt_sqe = ""
txt_sesa = ""
End Sub
Módulo:
Option Explicit
Sub registrar1()
Load frm_Datos
Sheets("List").Activate
frm_Datos.Show
End Sub
Function nDatos(nombres As String) As Integer
Application.ScreenUpdating = False
Sheets("List").Activate
Range("A2").Activate
nDatos = 0
Do While Not IsEmpty(ActiveCell)
If nombres = ActiveCell Then
nDatos = ActiveCell.Row
End If
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Function