' 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)
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
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 may need some tweaking (like changing xlYes to xlNo if column B has no header row):excel 2010.
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.i can't see any xlYes, in my 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