automated row erasing in excel

**buhnen** · 05-12-2008, 08:12 AM

Hello everybody,

I hope I can find here some help or ideas for solving the next issue: I'm an electric engineer who works with a software able to export lists under the excel format. Those lists include several times repeated elements in the cells.....As an image is better than thousand words, I just want to show you the next screen capture .

In this screen capture you can see that it is repeated, for instance, the element "KA13" 5 times. What I'd like to do is to get the exported lists "lighter" by removing the repeated 4 of the five repeated rows. I guess this must be done randomly since the adjacent cells in the same row have no logical conection between . I mean that you can't sort them by any criteria: The A column format is an index of pages and the B, C and D are referred to other parameters.

Any ideas of how to implement an excel program for achieving this?

Thanks in advance

**BigBas** · 05-12-2008, 09:46 AM

Based on the picture that you have shown, this macro should delete all reoccurrences of a value in column E, besides the first one.

Instructions:
Press Alt + F11 to open the VBE.
Go to INSERT-MODULE
Copy the code below and paste it into the module
Run the macro

Sub Delete_Multiples()
    Dim LastRow As Long
    Dim i As Long
    
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
    
    
    Application.ScreenUpdating = False
    For i = LastRow To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range("E:E"), Cells(i, 5)) > 1 Then
            Cells(i, 5).EntireRow.Delete
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

**buhnen** · 05-12-2008, 11:35 AM

Great job BigBas,

Your macro works really fine, congratulations! :-)...I only forgot to mention that the E column has empty cells as well that should be erased, but that's a minor detail anyway. It can always be done manually.

**BigBas** · 05-12-2008, 12:16 PM

Why do it manually if the system can do it for you?

Use this modified code to delete rows where (1) the value in column E is duplicated or (2) the value in Column E is blank.

Sub Delete_Multiples()
    Dim LastRow As Long
    Dim i As Long
    
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
    
    
    Application.ScreenUpdating = False
    For i = LastRow To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range("E:E"), Cells(i, 5)) > 1 Then
            Cells(i, 5).EntireRow.Delete
        ElseIf Cells(i, 5).Value = "" Then
            Cells(i, 5).EntireRow.Delete
        End If
    Next i
    Application.ScreenUpdating = True
End Sub