Macro VBA eliminar filas según valor de una celda para Excel

Tengo una tabla de excel en la cual periódicamente se registraran valores duplicados en algunas columnas porque el procedimiento así lo permite, sin embargo también en el mismo procedimiento esa tabla debe ser depurada eliminando los valores duplicados y cuando digo eliminar quiero decir TODOS los que se repitan (No dejar valores únicos).

Voy a tratar de graficar la tabla para hacerles más clara la idea:

Columna A          Columna L (Contar.si)          Columna M             

KSI1-3                            1                                     Alta

KSI2-4                            1                                     Alta

KSI2-5                            1                                     Alta

KSI2-6                           1                                      Alta

KSI1-8                           1                                      Alta

KSI1-10                         2                                     Baja

KSI1-10                         2                                     Baja

Como se puede ver en la columna A el código KSI1-10 esta duplicado, en la columna L esta detectado por la función Contar. Si y en la columna M se le da el valor de "Baja" a los duplicados a través de la función Si.

Estoy usando esta macro para eliminar los duplicados a través de identificar el valor "Baja" en la columna M, pero solo estoy logrando que elimine la primera "Baja" porque al eliminar la primera, por las fórmulas de las otras columnas automáticamente convierte la segunda en "Alta" y ahí se detiene, atención a la macro.

Sheets("xxxx").Select

Range("xxx").Select
Do While ActiveCell<>Empty
If ActiveCell="Baja" Then Selection.EntireRow.Delete
ActiveCell.Offset(1,0).Select
Loop

La columna L y M son dinámicas y por eso la macro solo cumple una parte de su función, La Columna A es estática pero no se como hacer que la macro elimine todo lo que se repita sin dejar valores únicos.

Respuesta
5

Utiliza la siguiente macro:

Sub eliminar()
'Por.DAM
    Dim f As New Collection
    Sheets("Hoja1").Select
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If UCase(Cells(i, "M")) = "BAJA" Then
            f.Add i
        End If
    Next
    For i = f.Count To 1 Step -1
        Rows(f(i)).Delete
    Next
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas