get a msgbox to appear and say "Number of duplicates = 0 "

Question

What the code is supposed to do:

Remove all the duplicate data in specified data range
Inform the user how many duplicates have been deleted in total (I have done this by removing the duplicate data and removing the blank rows and subtracting the original data set amount by the remainder)

**Im struggling with this: run a second time, get a msgbox to appear and say "Number of duplicates = 0 "

Sub Delete_Duplicate()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim sh As Worksheet
Dim rn As Range
Set sh = ThisWorkbook.Sheets("Data")

Dim k As Long

Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1

Range("A11:F11").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$A$10:$F$57250").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5 _
    , 6), Header:=xlYes

   On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

k = rn.Rows.Count + rn.Row - 1

response = MsgBox("Total Duplicate Rows Removed = " & 57250 - k & Chr(10) & "Continue?", _
vbYesNoCancel + vbQuestion, "MsgBox Demonstration")

"an error message appears". What error message, and on which line of the code does execution stop? You need to include these basic details before asking the community :) — Chris Melville
The error message was 1004 about their being no blanks the second time around this occurred on the line " Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete I have since fixed this but I have explained my problem above — Jessie
Could you please edit in the error message into the question itself? — LW001
*the error message has been solved I'm now trying to find a way for the message box to display ("Total Duplicate Rows Removed = 0") on the second time of running — Jessie
@Jessie Then ask a new Question for that and explain in a self-answer how you solved it. — LW001

Variatus Variatus · Accepted Answer · 2018-01-07T02:32:35

Your code looks like a flying time bomb because it deletes indiscriminately.

Any duplicates on the ActiveSheet which could be any sheet in any open workbook.
Entire rows in which any blank cell is found within its UsedRange. This could easily be every single row in the worksheet.

I have re-written your code to make it less dangerous. Before running it please change the name of the worksheet in the line Set Sh = ThisWorkbook.Sheets("Duplicates") and make sure that the line Const Rstart As Long = 11 correctly defines the worksheet row in which the first duplicate or blank is to be looked for (the row immediately below whatever headers or captions your sheet may have). Observe that the code looks in column A for the last used row in the worksheet as well as for blank cells where the entire row is presumed blank.

Option Explicit

Sub Delete_Duplicates()

    Const Rstart As Long = 11               ' first data row (excl captions)

    Dim Sh As Worksheet
    Dim Rend As Long
    Dim Rn As Range
    Dim k As Long
    Dim Response As VbMsgBoxResult
    Dim R As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Set Sh = ThisWorkbook.Sheets("Duplicates")
    With Sh
        Rend = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rn = Range(.Cells(Rstart, "A"), .Cells(Rend, "F"))
        Rn.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6)
        k = Rend
        Rend = .Cells(.Rows.Count, "A").End(xlUp).Row
        k = k - Rend

        ' there can be only one blank row because
        ' others were removed as duplicates
        R = Rn.Cells(1).End(xlDown).Row + 1
        If R < Rend Then
            .Rows(R).Delete
            k = k + 1
        End If
    End With

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    Response = MsgBox(k & " duplicate and blank rows were removed." & _
                      Chr(10) & "Continue?", _
                      vbYesNo Or vbQuestion, _
                      "MsgBox Demonstration")
    If Response = vbYes Then Delete_Duplicates
End Sub

get a msgbox to appear and say "Number of duplicates = 0 "

1 Answers