Eliminar filas que no contengan el texto de la celda ah1

¿Pero en cuál columna se debe verificar si existe el texto de la celda AH1?

¿O qué verifique en todas las columnas de la fila?

Te anexo las 2 opciones, la primera busca en toda la fila, si no encuentra el dato borra la fila:

Sub Eliminar_Diferentes()
'Por.Dante Amor
    dato = Range("AH1")
    If dato = "" Then
        MsgBox "Ingresa un dato en AH1"
        Exit Sub
    End If
    '
    For i = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row To 4 Step -1
        Set b = Rows(i).Find(dato, LookAt:=xlWhole)
        If b Is Nothing Then Rows(i).Delete
    Next
    MsgBox "Fin"
End Sub

La siguiente opción solamente busca en la columna "D", de igual manera, si no encuentra el dato, entonces borra la fila. Cambia la "D" por la columna que desees.

Sub Eliminar_Diferentes2()
'Por.Dante Amor
    dato = Range("AH1")
    If dato = "" Then
        MsgBox "Ingresa un dato en AH1"
        Exit Sub
    End If
    '
    For i = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row To 4 Step -1
        If Cells(i, "D") <> dato Then Rows(i).Delete
    Next
    MsgBox "Fin"
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: Eliminar_Diferentes
10. Aceptar.
11. Para ejecutarla dale click a la imagen.

.

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

.

Avísame cualquier duda

.

Gracias Dante, tus macros funcionan bien .

La primera tarde 7 minutos en ejecutarse y la segunda 5 minutos.

Perdón, ¿pero habría una forma de que sea más rápido el proceso..?

(Sera que revisa todas las filas del libro por eso se demora, con que revise hasta la fila 2000, para mi estaría bien.)

Utiliza la siguiente:

Sub Eliminar_Diferentes2()
'Por.Dante Amor
    dato = Range("AH1")
    If dato = "" Then
        MsgBox "Ingresa un dato en AH1"
        Exit Sub
    End If
    '
    For i = 2000 To 4 Step -1
        If Cells(i, "AH") <> dato Then Rows(i).Delete
    Next
    MsgBox "Fin"
End Sub

El tiempo de proceso depende de la capacidad de tu equipo, procesador, versiones, memoria, etc. Te sugiero que cierres las demás aplicaciones y solamente utilices excel para realizar la ejecución.

.

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

.

Perdón no quiero parecer molesto, ¿pero sigue tardando 5 minutos . sera porque me muestra cuando va eliminando fila por fila?

Lo probé dejando solo en uso el excel ( tengo windows 7- 64bit - intel core i5 - 3,50 hz - 8 gb ram)

No es ninguna molestia, me faltó agregar la instrucción Screenupdating, prueba con la siguiente

Sub Eliminar_Diferentes2()
'Por.Dante Amor
    Application.ScreenUpdating = False
    dato = Range("AH1")
    If dato = "" Then
        MsgBox "Ingresa un dato en AH1"
        Exit Sub
    End If
    '
    For i = 2000 To 4 Step -1
        If Cells(i, "AH") <> dato Then Rows(i).Delete
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

.

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

.

Dante, gracias de nuevo, pero lo probé y sigue tardando más de 5 minutos...

Y también le agregue

(Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False)  

 e igualmente tarda los mismo

Sub Eliminar_Diferentes2()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
    dato = Range("AH1")
    If dato = "" Then
        MsgBox "Ingresa un dato en AH1"
        Exit Sub
    End If
    '
    For i = 2000 To 4 Step -1
        If Cells(i, "AH") <> dato Then Rows(i).Delete
    Next
    MsgBox "Fin"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ActiveSheet.DisplayPageBreaks = True
    Application.CutCopyMode = False
End Sub

Dante, Elsa matilde me dice si vos podes;

Desarrollar una macro para filtrar por la col AH y luego eliminar las filas ...

Porque ella no tiene tiempo porque se va y vuelve el jueves..

Pero la macro funciona, el tema del tiempo lo podemos revisar con todo gusto, pero igual deberías valorar la respuesta.

Te dejo una macro para esto. Debes entrar al Editor, insertar un módulo y allí la copiarás.

Sub quitaFilas()
'x Elsamatilde
'recorre la col A hasta encontrar celda vacía = fin de rango
[A4].Select
While ActiveCell <> ""
    'se busca el dato de AH1 en toda la fila activa
    Set busco = Range("A" & ActiveCell.Row).EntireRow.Find(What:=[AH1], After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    'si el dato no se encuentra en la fila se la elimina, sino se pasa a la fila siguiente
    If busco Is Nothing Then
        ActiveCell.EntireRow.Delete
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Wend
End Sub

Se busca en la fila completa.... si solo debe buscar en un rango avisame para ajustarla.

Para ejecutarla podés dibujar un botón, un atajo de teclado o directamente desde el menú Macros. Este tema lo tengo explicado en la sección Macros de mi sitio.

Sdos.

Elsa

Gracias elsa tu macro funciona bien, pero tarda mucho el proceso, ¿si simplificamos la busque a una sola columna( AH) seria más rápido?

Si claro. Ahora se busca en toda la fila por no contar con más información de tu parte... aquí va ahora controlando solo la col AH.

El fin de rango lo sigue marcando la col A... pero esto también podés cambiarlo por la col que tenga celdas con datos hasta el final de la tabla.

Sub quitaFilas()
'x Elsamatilde
'recorre la col A hasta encontrar celda vacía = fin de rango
[AH4].Select
While Range("A" & ActiveCell.Row) <> ""
    'se busca el dato de AH1 en la col AH de la fila activa
    Set busco = Range("AH" & ActiveCell.Row).Find(What:=[AH1], After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
    'si el dato no se encuentra en la fila se la elimina, sino se pasa a la fila siguiente
    If busco Is Nothing Then
        ActiveCell.EntireRow.Delete
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Wend
End Sub

Sdos y no olvides valorar esta respuesta si el tema queda resuelto, sino comenta y lo seguimos tratando.

Elsa

OK ELSA ; ahora lo hizo más rápido tardo 5 minuto.

Pero la pregunta sería hay posibilidad que sea más rápido.( Las filas que recorre son 2000.)

Desde ya muchas gracias por tu colaboración