Limpiar Rango luego de Busqueda

A los integrantes de este foro, en ocasión recurro a su ayuda en como limpiar los rangos B4:G40, tras la búsqueda de un valor determinado que se posiciona en la celda A4, esta macro me fue brindada por Elsa Matilde.

Private Sub Worksheet_Change(ByVal Target As Range)
'x Elsamatilde
'se controla lo ingresado en A1,
'si queda vacía no se ejecuta sino se filtra hoja PLANILLA
If Target.Address(False, False) <> "A4" Then Exit Sub
If Target.Value = "" Then Exit Sub
'se limpia la hoja de datos anteriors
Range("B4:G" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
'se selecciona la celda destino para la copia
Range("B4").Select
'se guarda el dato ingresado para filtrarla la hoja Planilla
dato = Target.Value
Set hpl = Sheets("PLANILLA")
'se guarda cuál es la última fila con datos
fini = hpl.Range("C" & Rows.Count).End(xlUp).Row
'se quitan posibles filtros anteriores y se los establece en fila 7
If hpl.AutoFilterMode = True Then hpl.AutoFilterMode = False
hpl.Range("B7:AR7").AutoFilter
hpl.Range("$B$8:$AR$" & Range("B" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, _
Criteria1:=dato
'se copia las col C:G de tabla resultante en hoja1
hpl.Range("C8:G" & fini).SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("B4")
'se copia la col AR de la tabla resultante en col G de hoja1
hpl.Range("AR8:AR" & fini).SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("G4")
'se muestran todos los datos quedandose en Hoja1
hpl.ShowAllData
ActiveSheet.Range("B4").Select
End Sub

Imagen1: Digito el valor a buscar en la celda A4 y se muestra la información relacionado al valor de busqueda.

Imagen2: Luego de mostrar la información, requiero que al ubicarme en celda A4. Limpie los valores buscados en las celda B4:G40, ya sea con las teclas SUPR o DEL o posicionandome automaticamente en dicha celda A4, para así dar pase a buscar otro valor.

1 Respuesta

Respuesta
2

Pon el siguiente evento debajo del evento que ya tienes en tu hoja

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A4")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Range("B4:G" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    End If
End Sub

quedaría todo tu código de la hoja así:

Private Sub Worksheet_Change(ByVal Target As Range)
'x Elsamatilde
'se controla lo ingresado en A1,
'si queda vacía no se ejecuta sino se filtra hoja PLANILLA
If Target.Address(False, False) <> "A4" Then Exit Sub
If Target.Value = "" Then Exit Sub
'se limpia la hoja de datos anteriors
Range("B4:G" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
'se selecciona la celda destino para la copia
Range("B4").Select
'se guarda el dato ingresado para filtrarla la hoja Planilla
dato = Target.Value
Set hpl = Sheets("PLANILLA")
'se guarda cuál es la última fila con datos
fini = hpl.Range("C" & Rows.Count).End(xlUp).Row
'se quitan posibles filtros anteriores y se los establece en fila 7
If hpl.AutoFilterMode = True Then hpl.AutoFilterMode = False
hpl.Range("B7:AR7").AutoFilter
hpl.Range("$B$8:$AR$" & Range("B" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, _
Criteria1:=dato
'se copia las col C:G de tabla resultante en hoja1
hpl.Range("C8:G" & fini).SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("B4")
'se copia la col AR de la tabla resultante en col G de hoja1
hpl.Range("AR8:AR" & fini).SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("G4")
'se muestran todos los datos quedandose en Hoja1
hpl.ShowAllData
ActiveSheet.Range("B4").Select
End Sub
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A4")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Range("B4:G" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
    End If
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Feliz Año 2018

.

Buenas tardes amigo Dante, era lo que faltaba para complementar la búsqueda y luego dar un borrado a la celdas.

Feliz Año 2018

¡Gracias! 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas