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

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")

Answer 1

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