Delete duplicates and blanks

tuytuy

Board Regular
Joined
Mar 28, 2013
Messages
75
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 ...
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
here is what i've got but nothing is being deleted...
Code:
' 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)
 
Upvote 0
What version of Excel are you using?
 
Upvote 0
What about something like this:
Code:
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
 
Upvote 0
What about something like this:
Code:
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 ?
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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:
Code:
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
 
Upvote 0

Forum statistics

Threads
1,218,501
Messages
6,142,836
Members
450,450
Latest member
Rachel_D

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top