Delete duplicates and blanks

[tuytuy]

Hi,
i was trying to right a code that would find duplicates in column B and delete the whole row of the duplicate value. But all i've done doesn't seem to work ...

 

[tuytuy]

here is what i've got but nothing is being deleted...

' Delete duplicates


ActiveWorkbook.Sheets("BlackBerry").Activate
Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range


On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual




Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))


Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")


N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If


V = Rng.Cells(1, B).Value
If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(B), vbNullString) > 1 Then
        Rng.Rows(2).EntireRow.Delete
        N = N + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(B), V) > 1 Then
        Rng.Rows(2).EntireRow.Delete
        N = N + 1
    End If
End If
Next R


EndMacro:


Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

 

[JoeMo]

What version of Excel are you using?

 

[James Snyder]

What about something like this:

With rng
    .AutoFilter Field:=4, Criteria1:="=" ' .SpecialCells(xlCellTypeBlanks, xlTextValues)
    Set filteredRange = .Resize(.Rows.count, 1).Cells.SpecialCells(xlCellTypeVisible)
    If filteredRange.Cells.count = 1 Then
        .ShowAllData    ' No data, just the header row
    Else
        With filteredRange
            For Each currentRow In filteredRange
                currentRow.EntireRow.Delete ' Delete the row with a null
            Next currentRow
        End With    ' filteredRange
    End If
End With

 

[tuytuy]

excel 2010.

 

[tuytuy]

What about something like this:

With rng
    .AutoFilter Field:=4, Criteria1:="=" ' .SpecialCells(xlCellTypeBlanks, xlTextValues)
    Set filteredRange = .Resize(.Rows.count, 1).Cells.SpecialCells(xlCellTypeVisible)
    If filteredRange.Cells.count = 1 Then
        .ShowAllData    ' No data, just the header row
    Else
        With filteredRange
            For Each currentRow In filteredRange
                currentRow.EntireRow.Delete ' Delete the row with a null
            Next currentRow
        End With    ' filteredRange
    End If
End With

This only deletes empty rows doesn't it ?

 

[JoeMo]

excel 2010.

This may need some tweaking (like changing xlYes to xlNo if column B has no header row):
Range("B:B").RemoveDuplicates Columns:=1, Header:=xlYes

 

[tuytuy]

i can't see any xlYes, in my code.

 

[JoeMo]

i can't see any xlYes, in my code.

It's not in your code. It's in the single line of code I posted which you can use to replace essentially all of your code.

 

[James Snyder]

tuytuy, yes it is intended to delete only blank rows. I am working on a similar problem except that I need the data for an exceptions report before deleting, so cannot use the single line solution of JoeMo's. Try this:

With dataRange
    .AutoFilter Field:=4, Criteria1:=IsBlank
    Set filteredRange = .Resize(.Rows.count, 1).Cells.SpecialCells(xlCellTypeVisible)
    If filteredRange.Cells.count = 1 Then
        .ShowAllData    ' No data, just the header row
    Else
        With filteredRange
            For Each currentRow In filteredRange
                currentRow.EntireRow.Delete ' Delete the nullRow
            Next currentRow
        End With    ' filteredRange
    End If
End With