Deleting Duplicate with a Msg box which displays no of duplica
Hi Per,
Thanks of your code.
However this code is showing me compile Error at the following:
NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
(xlDown)).Rows.Count
I wasnt' able to run the code cause of the error.
Regards,
Uma
"Per Jessen" wrote:
Hi Uma
Try this:
Sub DeleteDuplicates()
Dim StartCell As Range
Dim LastCell As Range
Dim NoOfRec As Long
Dim NoOfUniq As Long
Dim NoOfDup As Long
Dim TempSh As Worksheet
Dim FilterSh As Worksheet
Application.ScreenUpdating = False
Set FilterSh = Worksheets("Sheet1")
Set TempSh = Worksheets.Add
FilterSh.Activate
Set StartCell = Range("A1")
Set LastCell = StartCell.End(xlDown)
NoOfRec = LastCell.Row - StartCell.Row
FilterSh.Range(StartCell, LastCell.Offset(0, 2)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=TempSh.Range( _
"A1"), Unique:=True
NoOfUniq = TempSh.Range("A2", TempSh.Range("A2").End
(xlDown)).Rows.Count
NoOfDup = NoOfRec - NoOfUniq
FilterSh.Range(StartCell, LastCell.Offset(0, 2)).Delete
With TempSh
.Range("A1", .Range("A1").End(xlDown).Offset(0, 2)).Copy _
Destination:=FilterSh.Range("A1")
End With
With Application
.DisplayAlerts = False
TempSh.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
Msg = MsgBox("Total Duplicated Detected: " & NoOfDup & vbLf & vbLf _
& "Unique Records: " & NoOfUniq, vbInformation, "Hello")
End Sub
Regards,
Per
On 19 Nov., 17:28, Uma Nandan
wrote:
Hi
Would kindly request you to help for the following:
1) I need a VBA Code to detect the duplicates based on below data. Have
given my comments in Column D for for more information.
2) After checking Column B with Column A & Column C the duplicates should be
detleted & should pop a message box that these many duplicates deleted. In
below mentioned Eg. the message box should display " Total Duplicated
Detected:2 , Unique Records:4"
__________________________________________________ ________
EG:
Column A ColumnB ColumnC Column D
COMPANY NAME PROSPECT NAME TITLE COMMENTS
Wachovia David Wishon SVP Not a duplicate
Wachovia David Wishon Associate Not a duplicate
Bank Of America Uma Nandan Researcher Not a duplicate
Citigroup Uma Nandan Researcher Not a duplicate
Wachovia David Wishon Associate Duplicate. Need to
delete
Bank Of America Uma Nandan Researcher Duplicate. Need to delete
__________________________________________________ ___________
Would appreciate if some one can help me with this. I have a data of 50,000
to perform this task.
Thanks in advance.
Regards,
Uma
|