Macro para filtro rápido en hoja excel y msgbox en caso de no haber dato filtrado
Tengo una hoja llamada HISTORY en el cual tengo muchos datos
Yo quisiera un filtro en base a dos criterios. El primero es que al poner en F1 el primer dato este me lo filtrara si existe por supuesto si no existe pues que salga un msgbox diciendo que no existe
Ahora si busco el primer criterio en F1 entonces pueda utilizar el segundo criterio que es F9
Si lo busca entonces que me filtre los datos bajo los dos criterios, en caso de que el primero lo busque y el segundo no, entonces un msgbox que salga que no hay dato encontrado.
Todo esto seria en :
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
entonces al borrar los datos por separado este me vaya quitando los filtros
aqui unas imagenes:
Aqui sin filtros
aqui con el primer criterio
aqui con el segundo
1 Respuesta
Te anexo la macro
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
'
If Not Intersect(Target, Range("F1")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
If Target.Value = "" Then Exit Sub
u = Range("F" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A12:T" & u).AutoFilter Field:=6, Criteria1:=Range("F1")
If Range("A12:A" & u).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "No existen encargados"
Exit Sub
End If
End If
If Not Intersect(Target, Range("F9")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Range("F1") = "" Then
MsgBox "Falta el encargado"
Exit Sub
End If
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
If Target.Value = "" Then Exit Sub
u = Range("F" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A12:T" & u).AutoFilter Field:=6, Criteria1:=Range("F1")
If Range("A12:A" & u).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "No existen encargados"
Exit Sub
End If
ActiveSheet.Range("A12:T" & u).AutoFilter Field:=2, Criteria1:=Range("F9")
If Range("A12:A" & u).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "No existen productos"
Exit Sub
End If
End If
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
